I’ve found that #'blink-matching-open tends not to show enough context when
the opening parenthesis has comma, ,@, etc. before it, if you’re writing
vaguely complicate macros. (See much of my code in tests/automated/.)
This change fixes that; it also highlights the particular parenthesis using
the isearch face, which is useful when you have multiple open parentheses on
the same line, as is usual with #'labels, #'macrolet.
Normally #'message, #'lmessage cannot show face information, because they
call #'format, which strips this. I’ve changed them not to call it when
there are no ARGS. A more exhaustive solution to this is probably to change
#'format to preserve extent information by default.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1387306192 -7200
# Node ID 94a6b8fbd56e98dd8d90de2b793cea1c5fd21353
# Parent cd4f5f1f1f4c20036b18e7b7ab56c919614b9bea
Use a face, show more context around open parenthesis, #'blink-matching-open
lisp/ChangeLog addition:
2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
* simple.el (blink-matching-open):
When showing the opening parenthesis in the minibiffer, use the
isearch face for it, in case there are multiple parentheses in the
text shown.
When writing moderately involved macros, it's often not enough
just to show the backquote context before the parenthesis
(e.g. @,.`). Skip over that when searching for useful context in
the same way we skip over space and tab.
* simple.el (message):
* simple.el (lmessage):
If there are no ARGS, don't call #'format. This allows extent
information to be passed through to the minibuffer.
It's probably better still to update #'format to preserve extent
info.
diff -r cd4f5f1f1f4c -r 94a6b8fbd56e lisp/ChangeLog
--- a/lisp/ChangeLog Tue Dec 17 19:29:10 2013 +0200
+++ b/lisp/ChangeLog Tue Dec 17 20:49:52 2013 +0200
@@ -1,3 +1,20 @@
+2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * simple.el (blink-matching-open):
+ When showing the opening parenthesis in the minibiffer, use the
+ isearch face for it, in case there are multiple parentheses in the
+ text shown.
+ When writing moderately involved macros, it's often not enough
+ just to show the backquote context before the parenthesis
+ (e.g. @,.`). Skip over that when searching for useful context in
+ the same way we skip over space and tab.
+ * simple.el (message):
+ * simple.el (lmessage):
+ If there are no ARGS, don't call #'format. This allows extent
+ information to be passed through to the minibuffer.
+ It's probably better still to update #'format to preserve extent
+ info.
+
2013-12-17 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el:
diff -r cd4f5f1f1f4c -r 94a6b8fbd56e lisp/simple.el
--- a/lisp/simple.el Tue Dec 17 19:29:10 2013 +0200
+++ b/lisp/simple.el Tue Dec 17 20:49:52 2013 +0200
@@ -3304,9 +3304,10 @@
(save-excursion
(save-restriction
(if blink-matching-paren-distance
- (narrow-to-region (max (point-min)
- (- (point) blink-matching-paren-distance))
- oldpos))
+ (narrow-to-region
+ (max (point-min)
+ (- (point) blink-matching-paren-distance))
+ oldpos))
(condition-case ()
(let ((parse-sexp-ignore-comments
(and parse-sexp-ignore-comments
@@ -3322,46 +3323,75 @@
(matching-paren (char-after blinkpos))))))
(if mismatch (setq blinkpos nil))
(if blinkpos
- (progn
- (goto-char blinkpos)
- (if (pos-visible-in-window-p)
- (and blink-matching-paren-on-screen
- (progn
- (auto-show-make-point-visible)
- (sit-for blink-matching-delay)))
- (goto-char blinkpos)
- (lmessage 'command "Matches %s"
- ;; Show what precedes the open in its line, if anything.
- (if (save-excursion
- (skip-chars-backward " \t")
- (not (bolp)))
- (buffer-substring (progn (beginning-of-line) (point))
- (1+ blinkpos))
- ;; Show what follows the open in its line, if anything.
- (if (save-excursion
- (forward-char 1)
- (skip-chars-forward " \t")
- (not (eolp)))
- (buffer-substring blinkpos
- (progn (end-of-line) (point)))
- ;; Otherwise show the previous nonblank line,
- ;; if there is one.
- (if (save-excursion
- (skip-chars-backward "\n \t")
- (not (bobp)))
- (concat
- (buffer-substring (progn
- (skip-chars-backward "\n \t")
- (beginning-of-line)
- (point))
- (progn (end-of-line)
- (skip-chars-backward " \t")
- (point)))
- ;; Replace the newline and other whitespace with `...'.
- "..."
- (buffer-substring blinkpos (1+ blinkpos)))
- ;; There is nothing to show except the char itself.
- (buffer-substring blinkpos (1+ blinkpos))))))))
+ (labels
+ ((buffer-substring-highlight-blinkpos (start end)
+ ;; Sometimes there are sufficiently many
+ ;; parentheses on a line that it's *very*
+ ;; useful to see exactly which is the match.
+ (let* ((string (buffer-substring start end))
+ (extent (make-extent (- blinkpos start)
+ (1+ (- blinkpos start))
+ string)))
+ (set-extent-face extent 'isearch)
+ (set-extent-property extent 'duplicable t)
+ string))
+ (before-backquote-context ()
+ ;; Just showing the backquote context is often not
+ ;; informative enough, if you're writing vaguely
+ ;; complex macros. Move past it.
+ (skip-chars-backward "`,@.")))
+ (declare (inline before-backquote-context))
+ (goto-char blinkpos)
+ (if (pos-visible-in-window-p)
+ (and blink-matching-paren-on-screen
+ (progn
+ (auto-show-make-point-visible)
+ (sit-for blink-matching-delay)))
+ (goto-char blinkpos)
+ (lmessage
+ 'command
+ (concat
+ "Matches "
+ ;; Show what precedes the open in its line, if
+ ;; anything.
+ (if (save-excursion
+ (before-backquote-context)
+ (skip-chars-backward " \t")
+ (not (bolp)))
+ (buffer-substring-highlight-blinkpos
+ (progn (beginning-of-line) (point))
+ (1+ blinkpos))
+ ;; Show what follows the open in its line, if
+ ;; anything.
+ (if (save-excursion
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (not (eolp)))
+ (buffer-substring-highlight-blinkpos
+ (progn (before-backquote-context) (point))
+ (progn (end-of-line (point))))
+ ;; Otherwise show the previous nonblank line,
+ ;; if there is one.
+ (if (save-excursion
+ (skip-chars-backward "\n \t")
+ (not (bobp)))
+ (concat
+ (buffer-substring
+ (progn (skip-chars-backward "\n \t")
+ (beginning-of-line)
+ (point))
+ (progn (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ ;; Replace the newline and other whitespace
+ ;; with `...'.
+ "..."
+ (buffer-substring-highlight-blinkpos
+ blinkpos (1+ blinkpos)))
+ ;; There is nothing to show except the char
+ ;; itself.
+ (buffer-substring-highlight-blinkpos
+ blinkpos (1+ blinkpos)))))))))
(cond (mismatch
(display-message 'no-log "Mismatched parentheses"))
((not blink-matching-paren-distance)
@@ -4501,9 +4531,9 @@
(if (and (null fmt) (null args))
(prog1 nil
(clear-message nil))
- (let ((str (apply 'format fmt args)))
- (display-message 'message str)
- str)))
+ (let ((string (if args (apply 'format fmt args) fmt)))
+ (display-message 'message string)
+ string)))
(defun lmessage (label fmt &rest args)
"Print a one-line message at the bottom of the frame.
@@ -4514,10 +4544,9 @@
(if (and (null fmt) (null args))
(prog1 nil
(clear-message label nil))
- (let ((str (apply 'format fmt args)))
- (display-message label str)
- str)))
-
+ (let ((string (if args (apply 'format fmt args) fmt)))
+ (display-message label string)
+ string)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; warning code ;;
--
‘Liston operated so fast that he once accidentally amputated an assistant’s
fingers along with a patient’s leg, […] The patient and the assistant both
died of sepsis, and a spectator reportedly died of shock, resulting in the
only known procedure with a 300% mortality.’ (Atul Gawande, NEJM, 2012)
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches