procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve pp-emacs-lisp-code backquote form printing

Browse source 
* lisp/emacs-lisp/pp.el (pp--quoted-or-unquoted-form-p): New helper
function.
(pp--insert-lisp): Take care of quoted, backquoted and
unquoted expressions; print using an recursive call.
(pp--format-list): Exclude more cases from printing as a function call
by default.  Print lists whose second-last element is an (un)quoting
symbol using dotted list syntax; e.g. (a b . ,c) instead of (a b \, c).
This commit is contained in:
Michael Heerdegen 2024-02-18 01:55:54 +01:00
parent 9a2ce74c37
commit bbc53e0bcf
1 changed files with 40 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
lisp/emacs-lisp/pp.el
View file

@ -430,23 +430,33 @@ the bounds of a region containing Lisp code to pretty-print."
(replace-match ""))
(insert-into-buffer obuf)))))
(defvar pp--quoting-syntaxes
`((quote . "'")
(function . "#'")
(,backquote-backquote-symbol . "`")
(,backquote-unquote-symbol . ",")
(,backquote-splice-symbol . ",@")))
(defun pp--quoted-or-unquoted-form-p (cons)
;; Return non-nil when CONS has one of the forms 'X, `X, ,X or ,@X
(let ((head (car cons)))
(and (symbolp head)
(assq head pp--quoting-syntaxes)
(let ((rest (cdr cons)))
(and (consp rest) (null (cdr rest)))))))
(defun pp--insert-lisp (sexp)
(cl-case (type-of sexp)
(vector (pp--format-vector sexp))
(cons (cond
((consp (cdr sexp))
(if (and (length= sexp 2)
(memq (car sexp) '(quote function)))
(cond
((symbolp (cadr sexp))
(let ((print-quoted t))
(prin1 sexp (current-buffer))))
((consp (cadr sexp))
(insert (if (eq (car sexp) 'quote)
"'" "#'"))
(pp--format-list (cadr sexp)
(set-marker (make-marker) (1- (point))))))
(pp--format-list sexp)))
(let ((head (car sexp)))
(if-let (((null (cddr sexp)))
(syntax-entry (assq head pp--quoting-syntaxes)))
(progn
(insert (cdr syntax-entry))
(pp--insert-lisp (cadr sexp)))
(pp--format-list sexp))))
(t
(prin1 sexp (current-buffer)))))
;; Print some of the smaller integers as characters, perhaps?
@ -470,15 +480,29 @@ the bounds of a region containing Lisp code to pretty-print."
(insert "]"))
(defun pp--format-list (sexp &optional start)
(if (and (symbolp (car sexp))
(not pp--inhibit-function-formatting)
(not (keywordp (car sexp))))
(if (not (let ((head (car sexp)))
(or pp--inhibit-function-formatting
(not (symbolp head))
(keywordp head)
(let ((l sexp))
(catch 'not-funcall
(while l
(when (or
(atom l) ; SEXP is a dotted list
;; Does SEXP have a form like (ELT... . ,X) ?
(pp--quoted-or-unquoted-form-p l))
(throw 'not-funcall t))
(setq l (cdr l)))
nil)))))
(pp--format-function sexp)
(insert "(")
(pp--insert start (pop sexp))
(while sexp
(if (consp sexp)
(pp--insert " " (pop sexp))
(if (not (pp--quoted-or-unquoted-form-p sexp))
(pp--insert " " (pop sexp))
(pp--insert " . " sexp)
(setq sexp nil))
(pp--insert " . " sexp)
(setq sexp nil)))
(insert ")")))