diff options
Diffstat (limited to 'lisp/emacs-lisp/pp.el')
| -rw-r--r-- | lisp/emacs-lisp/pp.el | 111 |
1 files changed, 84 insertions, 27 deletions
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el index 1d722051406..d586fc59939 100644 --- a/lisp/emacs-lisp/pp.el +++ b/lisp/emacs-lisp/pp.el @@ -166,12 +166,19 @@ it inserts and pretty-prints that arg at point." (interactive "r") (if (null end) (pp--object beg #'pp-fill) (goto-char beg) - (let ((end (copy-marker end t)) - (newline (lambda () - (skip-chars-forward ")]}") - (unless (save-excursion (skip-chars-forward " \t") (eolp)) - (insert "\n") - (indent-according-to-mode))))) + (let* ((end (copy-marker end t)) + (avoid-unbreakable + (lambda () + (and (memq (char-before) '(?# ?s ?f)) + (memq (char-after) '(?\[ ?\()) + (looking-back "#[sf]?" (- (point) 2)) + (goto-char (match-beginning 0))))) + (newline (lambda () + (skip-chars-forward ")]}") + (unless (save-excursion (skip-chars-forward " \t") (eolp)) + (funcall avoid-unbreakable) + (insert "\n") + (indent-according-to-mode))))) (while (progn (forward-comment (point-max)) (< (point) end)) (let ((beg (point)) @@ -193,11 +200,18 @@ it inserts and pretty-prints that arg at point." (and (save-excursion (goto-char beg) - (if (save-excursion (skip-chars-backward " \t({[',") - (bolp)) - ;; The sexp was already on its own line. - nil - (skip-chars-backward " \t") + ;; We skip backward over open parens because cutting + ;; the line right after an open paren does not help + ;; reduce the indentation depth. + ;; Similarly, we prefer to cut before a "." than after + ;; it because it reduces the indentation depth. + (while + (progn + (funcall avoid-unbreakable) + (not (zerop (skip-chars-backward " \t({[',."))))) + (if (bolp) + ;; The sexp already starts on its own line. + (progn (goto-char beg) nil) (setq beg (copy-marker beg t)) (if paired (setq paired (copy-marker paired t))) ;; We could try to undo this insertion if it @@ -346,6 +360,23 @@ after OUT-BUFFER-NAME." (setq buffer-read-only nil) (setq-local font-lock-verbose nil))))) +(defun pp-insert-short-sexp (sexp &optional width) + "Insert a short description of SEXP in the current buffer. +WIDTH is the maximum width to use for it and it defaults to the +space available between point and the window margin." + (let ((printed (format "%S" sexp))) + (if (and (not (string-search "\n" printed)) + (<= (string-width printed) + (or width (- (window-width) (current-column))))) + (insert printed) + (insert-text-button + "[Show]" + 'follow-link t + 'action (lambda (&rest _ignore) + ;; FIXME: Why "eval output"? + (pp-display-expression sexp "*Pp Eval Output*")) + 'help-echo "mouse-2, RET: pretty print value in another buffer")))) + ;;;###autoload (defun pp-eval-expression (expression) "Evaluate EXPRESSION and pretty-print its value. @@ -430,23 +461,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? @@ -458,6 +499,8 @@ the bounds of a region containing Lisp code to pretty-print." (string (let ((print-escape-newlines t)) (prin1 sexp (current-buffer)))) + (symbol + (prin1 sexp (current-buffer))) (otherwise (princ sexp (current-buffer))))) (defun pp--format-vector (sexp) @@ -468,15 +511,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 ")"))) |