How do I code walk in elisp? - emacs

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")

Related

How to extract XML processing instructions in Emacs Lisp?

I would like to extract the processing instructions (particularly xml-model) from an XML file; yet both (n)xml-parse-file as well as libxml-parse-xml-region do not recognize processing instructions.
Is there a clean way to extract processing instructions or do I have to regex search for PIs?
edit: Here is a first draft of the functionality I was looking for:
(cl-defun extract-processing-instructions (&rest processing-instructions)
"Extracts all/only the specified xml processing instructions from the current buffer and returns them as a list of string."
(interactive)
(let ((pi-re
(format "<\\?\\(%s\\).*\\?>" (string-join processing-instructions "\\|")))
(result))
(save-excursion
(goto-char (point-min))
(while (re-search-forward pi-re nil t)
(push (match-string 0) result)))
(nreverse result)))
(cl-defun pi-str2sexp (pi-str)
"Takes a processing instruction as a string and transforms it to a sexp-structure (in the style of xml-parse-*)."
(let (sexp attr-alist)
(save-match-data
;; get and push pi-element-name
;; (string-match "<\\?\\([[:alnum:]-]*\\)" pi-str)
(string-match "<\\?\\([[:alnum:]-]*\\)" pi-str)
(push (make-symbol (match-string 1 pi-str)) sexp)
;; construct attribute alist
(while (string-match "\\([[:alnum:]-]*\\)=\"\\([^ ]*\\)\""
pi-str (match-end 0))
(push (cons (make-symbol (match-string 1 pi-str))
(match-string 2 pi-str))
attr-alist)))
;; finally: push attr alist and return sexp
(push (nreverse attr-alist) sexp)
(nreverse sexp)))
edit 2: Turns out advicing/generally building upon xml-parse-* in this matter (like suggested by #Tom Regner) is a huge pain. :(
The thing I came up with was a context manager, the idea was to use it to around-advice string-parse-tag-1 (which is at the heart of xml-parse-* (of course stand-alone use is also an option):
(cl-defmacro --replace-first-group (regex-replace-alist)
`(save-excursion
(dolist (expression ,regex-replace-alist)
(goto-char (point-min))
(replace-regexp (car expression) (cadr expression)))))
(cl-defmacro with-parsable-pi (buffer &body body)
"Context manager that treats xml processing instructions in BUFFER as normal elements."
(declare (indent defun))
`(let ((old-buffer ,buffer))
(with-temp-buffer
(insert-buffer-substring old-buffer)
(goto-char (point-min))
(--replace-first-group '(("\\(\\?\\)>" "/>") ("<\\(\\?\\)" "<")))
,#body)))
This e.g. allows calls like
(with-parsable-pi (current-buffer)
(xml-parse-tag-1))
so it is at least possible to get an element at a time; but since the XML exposed in the context manager isn't actually valid and xml-parse-* (rightfully) errors if invalid XML is encountered, it isn't possible to process more than one element at a time.
I was thinking of maybe introducing a pseudo root element or something, but the kludge spiral is ghastly enough as it is.
Another idea of course would be to run an xpath query to extract processing instructions. If there only was a solid xpath solution in Emacs Lisp..
Ok, I think I found a satisfactory solution: xmltok-forward-prolog!
So here is the code I came up with for extracting processing instructions:
(cl-defun filter-xmltok-prolog (&optional (buffer (current-buffer))
(filter-re "processing-instruction-.*"))
"Filters the output of xmltok-forward-prolog (i.e. index 0 ('type') of each array) run in the context of BUFFER against FILTER-RE. Returns a list of vectors."
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(let ((raw-prolog-data (xmltok-forward-prolog)))
(seq-filter
#'(lambda (x)
(string-match filter-re (symbol-name (aref x 0))))
raw-prolog-data)))))
(cl-defun --merge-pi-data (pi-data)
"Meant to operate on data filtered with filter-xmltok-prolog against 'processing-instruction-.*'.
Merges processing-instruction-left/-right and returns a list of vectors holding the start/end coordinates of a processing instruction at index 1 and 2."
(let ((left (car pi-data))
(right (cadr pi-data)))
(cond
((null pi-data) nil)
(t (cons
(vector 'processing-instruction
(aref left 1) (aref right 2))
(--merge-pi-data (cddr pi-data)))))))
;; test
(--merge-pi-data '([processing-instruction-left 40 51] [processing-instruction-right 52 126]))
(cl-defun pi-str2s-exp (pi-str)
"Takes a processing instruction as a string and transforms it into a sexp structure (in the style of xml-parse-*)."
(let (sexp attr-alist)
(save-match-data
;; get and push pi-element-name
(string-match "<\\?\\([[:alnum:]-]*\\)" pi-str)
(push (make-symbol (match-string 1 pi-str)) sexp)
;; construct attribute alist
(while (string-match "\\([[:alnum:]-]*\\)=\"\\([^ ]*\\)\""
pi-str (match-end 0))
(push (cons (make-symbol (match-string 1 pi-str))
(match-string 2 pi-str))
attr-alist)))
;; finally: push attr alist and return sexp
(push (nreverse attr-alist) sexp)
(nreverse sexp)))
(cl-defun get-processing-instructions (&optional (buffer (current-buffer)))
"Extracts processing instructions from BUFFER and returns a list of sexp representations in the style of xml-parse-*."
(save-excursion
(mapcar #'pi-str2s-exp
(mapcar #'(lambda (v)
(buffer-substring (aref v 1) (aref v 2)))
(--merge-pi-data (filter-xmltok-prolog buffer))))))
(cl-defun test/get-pis-from-file (file)
(with-temp-buffer
(insert-file-contents file)
(get-processing-instructions)))
(test/get-pis-from-file "~/some/xml/file.xml")
I'm not at all an Emacs Lisp expert and this isn't at all tested thoroughly, but it works for now! :)

Destructuring bind for regex matches

In elisp, how can I get a destructuring bind for regex matches?
For example,
;; what is the equivalent of this with destructuring?
(with-temp-buffer
(save-excursion (insert "a b"))
(re-search-forward "\\(a\\) \\(b\\)")
(cons (match-string 1)
(match-string 2)))
;; trying to do something like the following
(with-temp-buffer
(save-excursion (insert "a b"))
(cl-destructuring-bind (a b) (re-search-forward "\\(a\\) \\(b\\)")
(cons a b)))
I was thinking I would have to write a macro to expand matches if there isn't another way.
Here is one way: you first extend pcase to accept a new re-match pattern, with a definition such as:
(pcase-defmacro re-match (re)
"Matches a string if that string matches RE.
RE should be a regular expression (a string).
It can use the special syntax \\(?VAR: to bind a sub-match
to variable VAR. All other subgroups will be treated as shy.
Multiple uses of this macro in a single `pcase' are not optimized
together, so don't expect lex-like performance. But in order for
such optimization to be possible in some distant future, back-references
are not supported."
(let ((start 0)
(last 0)
(new-re '())
(vars '())
(gn 0))
(while (string-match "\\\\(\\(?:\\?\\([-[:alnum:]]*\\):\\)?" re start)
(setq start (match-end 0))
(let ((beg (match-beginning 0))
(name (match-string 1 re)))
;; Skip false positives, either backslash-escaped or within [...].
(when (subregexp-context-p re start last)
(cond
((null name)
(push (concat (substring re last beg) "\\(?:") new-re))
((string-match "\\`[0-9]" name)
(error "Variable can't start with a digit: %S" name))
(t
(let* ((var (intern name))
(id (cdr (assq var vars))))
(unless id
(setq gn (1+ gn))
(setq id gn)
(push (cons var gn) vars))
(push (concat (substring re last beg) (format "\\(?%d:" id))
new-re))))
(setq last start))))
(push (substring re last) new-re)
(setq new-re (mapconcat #'identity (nreverse new-re) ""))
`(and (pred stringp)
(app (lambda (s)
(save-match-data
(when (string-match ,new-re s)
(vector ,#(mapcar (lambda (x) `(match-string ,(cdr x) s))
vars)))))
(,'\` [,#(mapcar (lambda (x) (list '\, (car x))) vars)])))))
and once that is done, you can use it as follows:
(pcase X
((re-match "\\(?var:[[:alpha:]]*\\)=\\(?val:.*\\)")
(cons var val)))
or
(pcase-let
(((re-match "\\(?var:[[:alpha:]]*\\)=\\(?val:.*\\)") X))
(cons var val))
This has not been heavily tested, and as mentioned in the docstring it doesn't work as efficiently as it (c|sh)ould when matching a string against various regexps at the same time. Also you only get the matched substrings, not their position. And finally, it applies the regexp search to a string, whereas in manny/most cases regexps searches are used in a buffer. But you may still find it useful.

Emacs jump to next annotated words or phrases

When using Emacs, I notice that words or phrases in a buffer can be annotated or highlighted by many minor modes like hi-lock-mode, flyspell-mode, flycheck-mode...
Is there any uniform way to jump to the highlighted words or phrases created by all these minor modes? Specifically, is there any package or function support jumping to the next and previous highlighted phrases?
When using Eclipse, I can do it by pressing Ctrl-. and Ctrl-,. However, when switching to Emacs, so far, I haven't found an equivalent feature.
Developing a mode which aims to tackle that kind of tasks
https://github.com/andreas-roehler/werkstatt/tree/master/general-key
Facilitates the setting of a general command.
Than this command gets different bindings according to modes - which needs to be edited by hand once. Afterwards it allows to set/change a key at one place for all related/bound commands.
See for example inside
https://github.com/andreas-roehler/werkstatt/blob/master/general-key/general-key-python-mode.el
It's alpha still notably for the install process. Bug reports resp. feature requests welcome.
Not surprisingly, #Drew has answered something related to this.
You can programmatically use isearch with something like:
(defun foo (regexp)
(interactive (list (read-regexp "Regexp: ")))
(isearch-mode t t)
(let ((isearch-regexp nil))
(isearch-yank-string regexp)))
This will pull your previous regexp history, including those from hi-lock. I imagine it would be a fun exercise to modify this to use hi-lock-regexp-history.
If you use swiper, you can restrict the search candidates to lines with highlighted patterns by hi-lock-mode.
Here is a simple wrapper of swiper:
(require 'cl-lib)
(defun swiper-over-highlights-simple ()
(interactive)
(let ((original-swiper--candidates (symbol-function 'swiper--candidates)))
(cl-letf (((symbol-function 'swiper--candidates)
(lambda ()
(let ((pattern (mapconcat #'car hi-lock-interactive-patterns "\\|")))
(cl-remove-if-not (lambda (x) (string-match-p pattern x))
(funcall original-swiper--candidates))))))
(swiper))))
In addition, you can change ivy-read's preselect argument, which initializes the first matched line inside swiper.
The following fuction, modified from swiper, finds the closest next line with a highlighted pattern:
(defun swiper-over-highlights (&optional initial-input)
(interactive)
(let ((original-swiper--candidates (symbol-function 'swiper--candidates))
(pattern (mapconcat #'car hi-lock-interactive-patterns "\\|")))
(cl-letf (((symbol-function 'swiper--candidates)
(lambda ()
(cl-remove-if-not (lambda (x) (string-match-p pattern x))
(funcall original-swiper--candidates)))))
(let ((candidates (swiper--candidates)))
(swiper--init)
(setq swiper-invocation-face
(plist-get (text-properties-at (point)) 'face))
(let ((preselect
(save-excursion
(search-forward-regexp pattern nil t)
(let* ((current-line-value (current-line))
(candidate-line-numbers (mapcar (lambda (x) (cadr (text-properties-at 0 x)))
candidates))
(preselect-line-num (cl-find-if (lambda (x) (<= current-line-value x))
candidate-line-numbers)))
(- (length candidate-line-numbers)
(length (member preselect-line-num candidate-line-numbers))))))
(minibuffer-allow-text-properties t)
res)
(unwind-protect
(and
(setq res
(ivy-read
"Swiper: "
candidates
:initial-input initial-input
:keymap swiper-map
:preselect preselect
:require-match t
:action #'swiper--action
:re-builder #'swiper--re-builder
:history 'swiper-history
:extra-props (list :fname (buffer-file-name))
:caller 'swiper))
(point))
(unless (or res swiper-stay-on-quit)
(goto-char swiper--opoint))
(isearch-clean-overlays)
(unless (or res (string= ivy-text ""))
(cl-pushnew ivy-text swiper-history))
(setq swiper--current-window-start nil)
(when swiper--reveal-mode
(reveal-mode 1))))))))

Convert command line arguments to list in Emacs Lisp

In an automated Emacs Lisp --batch/--script script I need to process the command line arguments given to the script.
I've gotten as far as getting the arguments into a list of the the form:
("--aaa=bbb" "--ccc=ddd=eee" "--blah")
Now, I need to convert them to a list of the form:
(("aaa" "bbb") ("ccc" "ddd=eee") ("blah"))
In Python I'd write something like;
output = []
for v in input:
output.append(v[2:].split("=", 1))
But have been unable to convert that code to Emacs Lisp. I found Elisp split-string function to split a string by . character but wasn't able to figure out how to make it only split on the first equals.
I was heading down a route of using (substring "abcdefg" x x) with (search) from the cl package but it felt like there should be a better way? I think also want to use (mapc '<function> input) where function does the v[2:].split("=",1) part.
You can use split-string. See the following code example.
(setq cmd-line '("--aaa=bbb" "--ccc=ddd=eee" "--blah"))
(setq cmd-line (mapcar (lambda (argstr)
(when (string-match "^--" argstr)
(split-string (substring argstr 2) "=")))
cmd-line))
The output is (("aaa" "bbb") ("ccc" "ddd" "eee") ("blah")).
That is not exactly what you want because of "eee". Maybe you can use that and just neglect "eee".
If the "eee" is really a problem a small modification helps:
(setq cmd-line '("--aaa=bbb" "--ccc=ddd=eee" "--blah"))
(setq cmd-line (mapcar (lambda (arg)
(when (string-match "^--" arg)
(setq arg (split-string (substring arg 2) "="))
(if (cdr arg)
(setcdr (cdr arg) nil))
arg))
cmd-line))
The output is:
(("aaa" "bbb") ("ccc" "ddd") ("blah"))
Variant for the new requirement in the question:
(setq cmd-line '("--aaa=bbb" "--ccc=ddd=eee" "--blah"))
(setq cmd-line (mapcar (lambda (arg)
(when (string-match "^--\\([^=]*\\)\\(?:=\\(.*\\)\\)?" arg)
(let ((opt (match-string 1 arg))
(val (match-string 2 arg)))
(if val
(list opt val)
(list opt)))))
cmd-line))
The output is:
(("aaa" "bbb") ("ccc" "ddd=eee") ("blah"))

Emacs proper cl-flet indentation?

The current indentation for cl-flet seems really ugly to me.
See for instance:
(defun foo (lst)
(cl-flet ((unusually-long-bar (x)
(1+ x)
(1+ x)
(1+ x)))
(mapcar #'unusually-long-bar lst)))
I'd like to set it to something more sensible, like:
(defun foo (lst)
(cl-flet ((unusually-long-bar (x)
(1+ x)
(1+ x)
(1+ x)))
(mapcar #'unusually-long-bar lst)))
How can I do this?
The following should work:
(setq lisp-indent-function 'common-lisp-indent-function)
(eval-after-load "cl-indent"
'(progn
(put 'cl-flet 'common-lisp-indent-function
(get 'flet 'common-lisp-indent-function))
))
By way of addition to Sabof's answer, here is a snippet which copies indentation rules from all Common Lisp symbols to their cl- prefixed Emacs equivalents, when the latter exist:
(load-library "cl-indent") ; defines the common-lisp-indent-function properties
(cl-loop for symbol being the symbols
for cl-indent-rule = (get symbol 'common-lisp-indent-function)
for elisp-equivalent = (intern-soft (concat "cl-" (symbol-name symbol)))
when (and cl-indent-rule elisp-equivalent (fboundp elisp-equivalent))
do (put elisp-equivalent 'common-lisp-indent-function cl-indent-rule))