xemacs-beta: lisp/simple.el comparison

comparison lisp/simple.el @ 5773:94a6b8fbd56e

Use a face, show more context around open parenthesis, #'blink-matching-open lisp/ChangeLog addition: 2013-12-17 Aidan Kehoe <kehoea@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.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Tue, 17 Dec 2013 20:49:52 +0200
parents	0eb4e96fd261
children	b79e1e02bf01

comparison

equal deleted inserted replaced

-:cd4f5f1f1f4c
+:94a6b8fbd56e
 	      (blinkpos)
 	      (mismatch))
 	 (save-excursion
 	   (save-restriction
 	     (if blink-matching-paren-distance
-		 (narrow-to-region (max (point-min)
+		 (narrow-to-region
-					(- (point) blink-matching-paren-distance))
+(max (point-min)
-				   oldpos))
+(- (point) blink-matching-paren-distance))
+oldpos))
 	     (condition-case ()
 		 (let ((parse-sexp-ignore-comments
 			(and parse-sexp-ignore-comments
 			     (not blink-matching-paren-dont-ignore-comments))))
 		   (setq blinkpos (scan-sexps oldpos -1)))
 		      (or (null (matching-paren (char-after blinkpos)))
 			  (/= (char-after (1- oldpos))
 			      (matching-paren (char-after blinkpos))))))
 	   (if mismatch (setq blinkpos nil))
 	   (if blinkpos
-	       (progn
+	       (labels
-		(goto-char blinkpos)
+((buffer-substring-highlight-blinkpos (start end)
-		(if (pos-visible-in-window-p)
+;; Sometimes there are sufficiently many
-		    (and blink-matching-paren-on-screen
+;; parentheses on a line that it's *very*
-			 (progn
+;; useful to see exactly which is the match.
-			   (auto-show-make-point-visible)
+(let* ((string (buffer-substring start end))
-			   (sit-for blink-matching-delay)))
+(extent (make-extent (- blinkpos start)
-		  (goto-char blinkpos)
+(1+ (- blinkpos start))
-		  (lmessage 'command "Matches %s"
+string)))
-		    ;; Show what precedes the open in its line, if anything.
+(set-extent-face extent 'isearch)
-		    (if (save-excursion
+(set-extent-property extent 'duplicable t)
-			  (skip-chars-backward " \t")
+string))
-			  (not (bolp)))
+(before-backquote-context ()
-			(buffer-substring (progn (beginning-of-line) (point))
+;; Just showing the backquote context is often not
-					  (1+ blinkpos))
+;; informative enough, if you're writing vaguely
-		      ;; Show what follows the open in its line, if anything.
+;; complex macros. Move past it.
-		      (if (save-excursion
+(skip-chars-backward "`,@.")))
-			    (forward-char 1)
+(declare (inline before-backquote-context))
-			    (skip-chars-forward " \t")
+(goto-char blinkpos)
-			    (not (eolp)))
+(if (pos-visible-in-window-p)
-			  (buffer-substring blinkpos
+(and blink-matching-paren-on-screen
-					    (progn (end-of-line) (point)))
+(progn
-			;; Otherwise show the previous nonblank line,
+(auto-show-make-point-visible)
-			;; if there is one.
+(sit-for blink-matching-delay)))
-			(if (save-excursion
+(goto-char blinkpos)
-			      (skip-chars-backward "\n \t")
+(lmessage
-			      (not (bobp)))
+'command
-			    (concat
+(concat
-			     (buffer-substring (progn
+"Matches "
-						 (skip-chars-backward "\n \t")
+;; Show what precedes the open in its line, if
-						 (beginning-of-line)
+;; anything.
-						 (point))
+(if (save-excursion
-					       (progn (end-of-line)
+(before-backquote-context)
-						      (skip-chars-backward " \t")
+(skip-chars-backward " \t")
-						      (point)))
+(not (bolp)))
-			     ;; Replace the newline and other whitespace with `...'.
+(buffer-substring-highlight-blinkpos
-			     "..."
+(progn (beginning-of-line) (point))
-			     (buffer-substring blinkpos (1+ blinkpos)))
+(1+ blinkpos))
-			  ;; There is nothing to show except the char itself.
+;; Show what follows the open in its line, if
-			  (buffer-substring blinkpos (1+ blinkpos))))))))
+;; 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)
 		    (display-message 'no-log "Unmatched parenthesis"))))))))
 ;; (if (framep default-minibuffer-frame)
 ;;     (make-frame-visible default-minibuffer-frame))
 (if (and (null fmt) (null args))
 (prog1 nil
 	(clear-message nil))
-(let ((str (apply 'format fmt args)))
+(let ((string (if args (apply 'format fmt args) fmt)))
-(display-message 'message str)
+(display-message 'message string)
-str)))
+string)))
 (defun lmessage (label fmt &rest args)
 "Print a one-line message at the bottom of the frame.
 First argument LABEL is an identifier for this message.  The rest of the
 arguments are the same as to `format'.
 See `display-message' for a list of standard labels."
 (if (and (null fmt) (null args))
 (prog1 nil
 	(clear-message label nil))
-(let ((str (apply 'format fmt args)))
+(let ((string (if args (apply 'format fmt args) fmt)))
-(display-message label str)
+(display-message label string)
-str)))
+string)))
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;                              warning code                             ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Mercurial > hg > xemacs-beta

comparison lisp/simple.el @ 5773:94a6b8fbd56e