I want to find all files that ends with .jpg, .png or .jpeg.
I write something like this:
(defun get-picture (dir)
(remove-if-not (lambda (item)
(or (string= ".jpg" (pathname-type item))
(string= ".png" (pathname-type item))
(string= ".jpeg" (pathname-type item))))
(uiop:directory-files dir)))
But it doesn't look good to me. For example, when you want to search more. So I write this:
(defun search-file (dir file-types)
(remove-if-not (lambda (item)
(mapc (lambda (type)
(string= type (pathname-type item)))
file-types))
(uiop:directory-files dir)))
But apparently, mapc is not correctly here.
So I'm wondering is there anyway better to do it(besides dolist)?
(defun get-picture-files (d &key
(extensions '("jpg" "png" "jpeg"))
(test #'string-equal))
(remove-if (lambda (p)
(not (member (pathname-type p)
extensions
:test test)))
(uiop:directory-files d)))
This
lets you specify the extensions;
and the test (so "GOO.JPG");
calls pathname-type just once;
doesn't use remove-if-not which is deprecated.
Related
I am writing a Common Lisp macro define-computation which defines functions in a specific way and marks them by adding a property :computation to the property list of the symbol of the defined function.
The define-computation is looking for forms which are funcalls of a function with the :computation property set and wrap them with a specific code.
When I work in the REPL my code below is working as expected and macroexpansion allows me to validate that the defined-computation is properly wrapped by supervise-computation:
CL-USER> (macroexpand-1 '(define-computation c-2 ()
(c-1)
(format t "~&Compute something 2")))
(PROG1
(DEFUN C-2 ()
(DECLARE (OPTIMIZE (SAFETY 3) (SPACE 3)))
(SUPERVISE-COMPUTATION
(C-1))
(FORMAT T "~&Compute something 2"))
(EXPORT 'C-2)
(SETF (GET 'C-2 :COMPUTATION) T))
T
However when my code is organised in an ADSF system so that c-1 and c-2 are in a file and c-3 in another, I see that the code generated for c-2 is actually not wrapping c-1.
(PROG1
(DEFUN C-2 ()
(DECLARE (OPTIMIZE (SAFETY 3) (SPACE 3)))
(C-1)
(FORMAT T "~&Compute something 2"))
(EXPORT 'C-2)
(SETF (GET 'C-2 :COMPUTATION) T))
It seems to be true with SBCL and CCL64.
I am guessing this is caused by the interaction of macro expansion and loading/compiling logic but I am not well-versed enough in these aspects
of Lisp to explain and solve the undesired behaviour.
Given the code below, how can I organise it in an ADSF module so that C-1, and C-2 are defined in a file and C-3 in another, and so that the macro-expansion of C-2 features the form (SUPERVISE-COMPUTATION (C-1)) instead of just (C-1) when the system is loaded. (Again, evaluating the form below in the REPL will not display the problem.)
(defmacro supervise-computation (&body body-forms)
"Supervise the computation BODY-FORMS."
`(progn
(format t "~&---> Computation starts")
,#body-forms
(format t "~&---> Computation stops")))
(defun define-computation/wrap-computation-forms (body-forms)
"Walks through BODY-FORMS and wrap computation forms in a fixture."
(labels
((is-funcall-p (form)
(when (and (listp form) (not (null form)) (symbolp (first form)) (listp (rest form)))
(case (first form)
((funcall apply)
(second form))
(t (first form)))))
(is-computation-form-p (form)
(get (is-funcall-p form) :computation))
(wrap-computation-forms (form)
(cond
((is-computation-form-p form)
`(supervise-computation ,form))
((is-funcall-p form)
(cons (first form) (mapcar #'wrap-computation-forms (rest form))))
(t
form))))
(mapcar #'wrap-computation-forms body-forms)))
(defmacro define-computation (computation-name computation-args &body body)
`(prog1
(defun ,computation-name ,computation-args
(declare (optimize (safety 3) (space 3)))
,#(define-computation/wrap-computation-forms body))
(export (quote ,computation-name))
(setf (get (quote ,computation-name) :computation) t)))
(define-computation c-1 ()
(format t "~&Compute something 1"))
(define-computation c-2 ()
(c-1)
(format t "~&Compute something 2"))
(define-computation c-3 ()
(c-2)
(format t "~&Compute something 3"))
Sleeping over it and looking at other people's code (thank you anaphora) I could figure out a better way to write the macro is
(defmacro define-computation (computation-name computation-args &body body)
(setf (get computation-name :computation) t)
`(prog1
(defun ,computation-name ,computation-args
(declare (optimize (safety 3) (space 3)))
,#(define-computation/wrap-computation-forms body)
(export (quote ,computation-name))))
This ensures the property is set at macro evaluation time.
How do I generate an enumerated list of all tags (e.g., :tag:) in an org-mode file? Say I have a list of the form:
* Head1 :foo:bar:
** Subhead1 :foo:
* Head2
** Subhead2 :foo:bar:
I want to generate a list of all tags in this file as well as how many times each tag was used. Say something like,
:foo: 3
:bar: 2
Here is a shorter version.
(defun get-tag-counts ()
(let ((all-tags '()))
(org-map-entries
(lambda ()
(let ((tag-string (car (last (org-heading-components)))))
(when tag-string
(setq all-tags
(append all-tags (split-string tag-string ":" t)))))))
;; now get counts
(loop for tag in (-uniq all-tags)
collect (cons tag (cl-count tag all-tags :test 'string=)))))
I could not make use of the code posted by John Kitchin, as it requires an interactive function. bpalmer from IRC freenode/#emacs was so kind to help me out. Please find a working example that spits out all tags below the respective tree.
; use this in order to be able to use loop on its own
(require 'cl)
;; count tags (see John's answer)
(defun get-tag-counts ()
(let ((all-tags '()))
(org-map-entries
(lambda ()
(let ((tag-string (car (last (org-heading-components)))))
(when tag-string
(setq all-tags
(append all-tags (split-string tag-string ":" t)))))))
;; now get counts
(loop for tag in (seq-uniq all-tags)
collect (cons tag (cl-count tag all-tags :test 'string=)))))
;; wrap get-tag-counts in an interactive function
(defun create-tag-counts-buffer ()
(interactive)
(let ((tags (get-tag-counts)) (b (get-buffer-create "*Org Tag Count*")))
(dolist (tag tags) (insert (car tag)) (insert "\n")) (display-buffer b)))
Here is an approach.
(setq my-hash (make-hash-table :test 'equal))
(org-map-entries
(lambda ()
(let ((tag-string (car (last (org-heading-components))))
(current-count))
(when tag-string
(dolist (tag (split-string tag-string ":" t))
(setq current-count (gethash tag my-hash))
(if current-count;
(puthash tag (+ 1 current-count) my-hash)
(puthash tag 1 my-hash))
)
)
)
)
)
;; https://github.com/Wilfred/ht.el
(require 'ht)
(ht-map
(lambda (key value)
(list key value))
my-hash)
Is it possible to view the open buffers grouped by directories in emacs ido-buffer mode, in some sort of tree representation?
"emacs ido-buffer mode" ??
Did you mean ibuffer? If so...
It's not grouping1, but sorting by filename is a fairly useful approximation, and is available by default.
sf
Unfortunately (to my mind) dired buffers aren't included. You might fix that by defining a variant of the sorter which includes them, and then remapping the binding:
(eval-after-load 'ibuffer
'(progn
(define-ibuffer-sorter filename/directory/process
"Sort the buffers by their file name/process name."
(:description "file name")
(string-lessp
(or (buffer-file-name (car a))
(let ((dir (buffer-local-value 'dired-directory (car a))))
(if (consp dir) (car dir) dir))
(let ((pr-a (get-buffer-process (car a))))
(and (processp pr-a) (process-name pr-a))))
(or (buffer-file-name (car b))
(let ((dir (buffer-local-value 'dired-directory (car b))))
(if (consp dir) (car dir) dir))
(let ((pr-b (get-buffer-process (car b))))
(and (processp pr-b) (process-name pr-b))))))
(define-key ibuffer-mode-map
[remap ibuffer-do-sort-by-filename/process]
'ibuffer-do-sort-by-filename/directory/process)))
1 A function to dynamically group by directory would be nifty.
I'm trying to open a file and read through the sexps. If the form has setq in its first position then traverse the rest of the form adding the in the setq form to an alist.
;;; File passwords.el.gpg
(setq twitter-password "Secret"
github-password "Sauce")
My goal is to able to construct an alist from the pairs in the setq forms in teh file. How I even start?
First, I second the recommendation that you store the passwords in an actual alist and, if necessary, set whatever variables you need to based on that.
That aside, here's another solution that tries to break things out a bit. The -partition function is from the dash.el library, which I highly recommend.
You don't really need to "walk" the code, just read it in and check if its car is setq. The remainder of the form should then be alternating symbols and strings, so you simply partition them by 2 and you have your alist. (Note that the "pairs" will be proper lists as opposed to the dotted pairs in Sean's solution).
(defun setq-form-p (form)
(eq (car form) 'setq))
(defun read-file (filename)
(with-temp-buffer
(insert-file-literally filename)
(read (buffer-substring-no-properties 1 (point-max)))))
(defun credential-pairs (form)
(-partition 2 (cdr form)))
(defun read-credentials-alist (filename)
(let ((form (read-file filename)))
(credential-pairs form)))
;; usage:
(read-credentials-alist "passwords.el")
Alternatively, here's how it would work if you already had the passwords in an alist, like so
(defvar *passwords*
'((twitter-password "Secret")
(github-password "Sauce")))
And then wanted to set the variable twitter-password to "Sauce" and so on. You would just map over it:
(mapcar #'(lambda (pair)
(let ((name (car pair))
(value (cadr pair)))
(set name value)))
*passwords*)
You can use streams to read in the files (read-from-string) and then do the usual elisp hacking. The below isn't robust, but you get the idea. On a file, pwd.el that has your file, it returns the alist ((github-password . "Sauce") (twitter-password . "Secret"))
(defun readit (file)
"Read file. If it has the form (sexp [VAR VALUE]+), return
an alist of the form ((VAR . VALUE) ...)"
(let* (alist
(sexp-len
(with-temp-buffer
(insert-file-contents file)
(read-from-string (buffer-substring 1 (buffer-size)))))
(sexp (car sexp-len)))
(when (equal (car sexp) 'setq)
(setq sexp (cdr sexp))
(while sexp
(let* ((l (car sexp))
(r (cadr sexp)))
(setq alist (cons (cons l r) alist)
sexp (cddr sexp)))))
alist))
(readit "pwd.el")
The code is below but seems to have an error because it says when started can't find the remove duplicates function. Anyone have an idea how to fix this?? There is a second code on the same page with the problem. Essentially I can get it working but I want it to remove the directory names. I don't care as much about if there are duplicates. This code was posted on this page:
http://www.emacswiki.org/emacs/RecentFiles
(defun recentf-interactive-complete ()
"find a file in the recently open file using ido for completion"
(interactive)
(let* ((all-files recentf-list)
(file-assoc-list (mapcar (lambda (x) (cons (file-name-nondirectory x) x)) all-files))
(filename-list (remove-duplicates (mapcar 'car file-assoc-list) :test 'string=))
(ido-make-buffer-list-hook
(lambda ()
(setq ido-temp-list filename-list)))
(filename (ido-read-buffer "Find Recent File: "))
(result-list (delq nil (mapcar (lambda (x) (if (string= (car x) filename) (cdr x))) file-assoc-list)))
(result-length (length result-list)))
(find-file
(cond
((= result-length 0) filename)
((= result-length 1) (car result-list))
( t
(let ( (ido-make-buffer-list-hook
(lambda ()
(setq ido-temp-list result-list))))
(ido-read-buffer (format "%d matches:" result-length))))
The "remove-duplicates" function is located in the cl-seq.el file and is included in all recent versions of Emacs. It is loaded as part of the "cl" package so you just need the following line in your Emacs init file:
(require 'cl)