xemacs-beta: lisp/prim/simple.el comparison

comparison lisp/prim/simple.el @ 193:f53b5ca2e663 r20-3b23

Import from CVS: tag r20-3b23

author	cvs
date	Mon, 13 Aug 2007 09:58:30 +0200
parents	489f57a838ef
children	a2f645c6b9f8

comparison

equal deleted inserted replaced

-:9d35321dd38c
+:f53b5ca2e663
 ;; for the following command.
 (setq this-command t)
 (let ((modified (buffer-modified-p))
 	(recent-save (recent-auto-save-p)))
 (or (eq (selected-window) (minibuffer-window))
-	(message "Undo!"))
+	(display-message 'command "Undo!"))
 (or (and (eq last-command 'undo)
 	     (eq (current-buffer) last-undo-buffer)) ; XEmacs
 	(progn (undo-start)
 	       (undo-more 1)))
 (undo-more (or arg 1))
 (if (markerp end) (setq end (marker-position end)))
 (or (and beg end) (if zmacs-regions ;; rewritten for I18N3 snarfing
 			(error "The region is not active now")
 		      (error "The mark is not set now")))
 (if verbose (if buffer-read-only
-		  (message "Copying %d characters"
+		  (display-message
-			   (- (max beg end) (min beg end)))
+		   'command
-		(message "Killing %d characters"
+		   (format "Copying %d characters"
-			 (- (max beg end) (min beg end)))))
+			   (- (max beg end) (min beg end))))
+		(display-message
+		 'command
+		 (format "Killing %d characters"
+			 (- (max beg end) (min beg end))))))
 (cond
 ;; I don't like this large change in behavior -- jwz
 ;; Read-Only text means it shouldn't be deleted, so I'm restoring
 ;; this code, but only for text-properties and not full extents. -sb
 ;; XEmacs
 (interactive "_")
 (if (interactive-p)
 (progn
 	(setq this-command 'kill-region)
-	(message "If the next command is a kill, it will append"))
+	(display-message 'command
+			 "If the next command is a kill, it will append"))
 (setq last-command 'kill-region)))
 (defun yank-pop (arg)
 "Replace just-yanked stretch of killed text with a different stretch.
 This command is allowed only immediately after a `yank' or a `yank-pop'.
 (progn
 (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
 nil buffer)
 (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))))
 (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
-(message "Mark set"))
+(display-message 'command "Mark set"))
 (if activate-region
 (progn
 	(setq zmacs-region-stays t)
 	(zmacs-activate-region)))
 ; (if (or activate (not transient-mark-mode)) ; FSF
 The goal column is stored in the variable `goal-column'."
 (interactive "_P") ; XEmacs
 (if arg
 (progn
 (setq goal-column nil)
-(message "No goal column"))
+(display-message 'command "No goal column"))
 (setq goal-column (current-column))
 (message (substitute-command-keys
 	      "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
 	     goal-column))
 nil)
 	    (re-search-backward comment-start-skip)
 	    (beginning-of-line)
 	    (re-search-forward comment-start-skip)
 	    (goto-char (match-beginning 0))
 	    (setq comment-column (current-column))
-	    (message "Comment column set to %d" comment-column))
+	    (display-message
+	     'command
+	     (format "Comment column set to %d" comment-column)))
 	  (indent-for-comment))
 (setq comment-column (current-column))
-(message "Comment column set to %d" comment-column))))
+(display-message
+'command
+(format "Comment column set to %d" comment-column)))))
 (defun kill-comment (arg)
 "Kill the comment on this line, if any.
 With argument, kill comments on that many lines starting with this one."
 ;; this function loses in a lot of situations.  it incorrectly recognises
 	((consp arg)
 	 (setq fill-column (current-column)))
 	;; Disallow missing argument; it's probably a typo for C-x C-f.
 	(t
 	 (error "set-fill-column requires an explicit argument")))
-(message "fill-column set to %d" fill-column))
+(display-message 'command "fill-column set to %d" fill-column))
 (defcustom comment-multi-line t ; XEmacs - this works well with adaptive fill
 "*Non-nil means \\[indent-new-comment-line] should continue same comment
 on new line, with no new terminator or starter.
 This is obsolete because you might as well use \\[newline-and-indent]."
 		    (and blink-matching-paren-on-screen
 			 (progn
 			   (auto-show-make-point-visible)
 			   (sit-for blink-matching-delay)))
 		  (goto-char blinkpos)
-		  (message
+		  (display-message
-		   "Matches %s"
+		   'command
-		   ;; Show what precedes the open in its line, if anything.
+		   (format
-		   (if (save-excursion
+		    "Matches %s"
-			 (skip-chars-backward " \t")
+		    ;; Show what precedes the open in its line, if anything.
-			 (not (bolp)))
+		    (if (save-excursion
-		       (buffer-substring (progn (beginning-of-line) (point))
+			  (skip-chars-backward " \t")
-					 (1+ blinkpos))
+			  (not (bolp)))
-		     ;; Show what follows the open in its line, if anything.
+			(buffer-substring (progn (beginning-of-line) (point))
-		     (if (save-excursion
+					  (1+ blinkpos))
-			   (forward-char 1)
+		      ;; Show what follows the open in its line, if anything.
-			   (skip-chars-forward " \t")
+		      (if (save-excursion
-			   (not (eolp)))
+			    (forward-char 1)
-			 (buffer-substring blinkpos
+			    (skip-chars-forward " \t")
-					   (progn (end-of-line) (point)))
+			    (not (eolp)))
-		       ;; Otherwise show the previous nonblank line,
+			  (buffer-substring blinkpos
-		       ;; if there is one.
+					    (progn (end-of-line) (point)))
-		       (if (save-excursion
+			;; Otherwise show the previous nonblank line,
-			     (skip-chars-backward "\n \t")
+			;; if there is one.
-			     (not (bobp)))
+			(if (save-excursion
-			   (concat
+			      (skip-chars-backward "\n \t")
-			    (buffer-substring (progn
+			      (not (bobp)))
-					       (skip-chars-backward "\n \t")
+			    (concat
-					       (beginning-of-line)
+			     (buffer-substring (progn
-					       (point))
+						 (skip-chars-backward "\n \t")
-					      (progn (end-of-line)
+						 (beginning-of-line)
-						     (skip-chars-backward " \t")
+						 (point))
-						     (point)))
+					       (progn (end-of-line)
-			    ;; Replace the newline and other whitespace with `...'.
+						      (skip-chars-backward " \t")
-			    "..."
+						      (point)))
-			    (buffer-substring blinkpos (1+ blinkpos)))
+			     ;; Replace the newline and other whitespace with `...'.
-			 ;; There is nothing to show except the char itself.
+			     "..."
-			 (buffer-substring blinkpos (1+ blinkpos))))))))
+			     (buffer-substring blinkpos (1+ blinkpos)))
+			  ;; There is nothing to show except the char itself.
+			  (buffer-substring blinkpos (1+ blinkpos)))))))))
 	     (cond (mismatch
-		    (message "Mismatched parentheses"))
+		    (display-message 'no-log "Mismatched parentheses"))
 		   ((not blink-matching-paren-distance)
-		    (message "Unmatched parenthesis"))))))))
+		    (display-message 'no-log "Unmatched parenthesis"))))))))
 ;Turned off because it makes dbx bomb out.
 (setq blink-paren-function 'blink-matching-open)
 (eval-when-compile (defvar myhelp))	; suppress compiler warning
 ;;
 ;; So, I left only a few of the really useless ones on this kill-list.
 ;;
 ;;                                            --hniksic
 (defvar log-message-ignore-regexps
-'(;; Often-seen messages
+'(;; Note: adding entries to this list slows down messaging
+;; significantly.  Wherever possible, use message lables.
+;; Often-seen messages
 "\\`\\'"				; empty message
-;;"^Mark set$"
+"\\`\\(Beginning\\|End\\) of buffer\\'"
-;;"^\\(Beginning\\|End\\) of buffer$"
 ;;"^Quit$"
-;;"^Killing [0-9]+ characters$"
-;; saving
-;;"^Saving file .*\\.\\.\\.$"		; note: cannot ignore ^Wrote, because
-					; it would kill off too much stuff.
-;;"^(No changes need to be saved)$"
-;;"^(No files need saving)$"
-;; undo, with the output of redo.el
-"\\`Undo[!.]+\\'"
-"\\`Redo[!.]+\\'"
-;; M-x compile
-;;"^Parsing error messages\\.\\.\\."
-;; M-!
-;;"^(Shell command completed with no output)"
-;; font-lock
-"\\`Fontifying"
-;; isearch
-;;"^\\(Failing \\)?\\([Ww]rapped \\)?\\([Rr]egexp \\)?I-search\\( backward\\)?:"
-;;"^Mark saved where search started$"
-;; menus
-;;"^Selecting menu item"
 ;; completions
+;; Many packages print this -- impossible to categorize
 ;;"^Making completion list"
-;;"^Matches "				; paren-matching message
-;; help
-;;"^Type .* to \\(remove help\\|restore the other\\) window."
-;; VM
-;;"^\\(Parsing messages\\|Reading attributes\\|Generating summary\\|Building threads\\|Converting\\)\\.\\.\\. [0-9]+$"
-;;"^End of message"			; + Gnus
 ;; Gnus
-;;"^No news is no news$"
+;; "^No news is no news$"
-;;"^No more\\( unread\\)? newsgroups$"
+;; "^No more\\( unread\\)? newsgroups$"
-;;"^Opening [^ ]+ server\\.\\.\\."
+;; "^Opening [^ ]+ server\\.\\.\\."
-;;"^[^:]+: Reading incoming mail"
+;; "^[^:]+: Reading incoming mail"
-;;"^Getting mail from "
+;; "^Getting mail from "
-;;"^\\(Generating Summary\\|Sorting threads\\|Making sparse threads\\|Scoring\\|Checking new news\\|Expiring articles\\|Sending\\)\\.\\.\\."
+;; "^\\(Generating Summary\\|Sorting threads\\|Making sparse threads\\|Scoring\\|Checking new news\\|Expiring articles\\|Sending\\)\\.\\.\\."
-;;"^\\(Fetching headers for\\|Retrieving newsgroup\\|Reading active file\\)"
+;; "^\\(Fetching headers for\\|Retrieving newsgroup\\|Reading active file\\)"
-;;"^No more\\( unread\\)? articles"
+;; "^No more\\( unread\\)? articles"
-;;"^Deleting article "
+;; "^Deleting article "
 ;; W3
-;;"^Parsed [0-9]+ of [0-9]+ ([0-9]+%)"
+;; "^Parsed [0-9]+ of [0-9]+ ([0-9]+%)"
-;; outl-mouse
-;;"^Adding glyphs\\.\\.\\."
-;; bbdb
-;;"^->"
 )
 "List of regular expressions matching messages which shouldn't be logged.
 See `log-message'.
 Ideally, packages which generate messages which might need to be ignored

Mercurial > hg > xemacs-beta

comparison lisp/prim/simple.el @ 193:f53b5ca2e663 r20-3b23