diff lisp/simple.el @ 278:90d73dddcdc4 r21-0b37

Import from CVS: tag r21-0b37
author cvs
date Mon, 13 Aug 2007 10:31:29 +0200
parents c5d627a313b1
children 7df0dd720c89
line wrap: on
line diff
--- a/lisp/simple.el	Mon Aug 13 10:30:38 2007 +0200
+++ b/lisp/simple.el	Mon Aug 13 10:31:29 2007 +0200
@@ -569,7 +569,7 @@
   "Print the number of words in BUFFER.
 If called noninteractively, the value is returned rather than printed.
 BUFFER defaults to the current buffer."
-  (interactive "bBuffer: ")
+  (interactive "_bBuffer: ")
   (let ((words (count-words-region (point-min) (point-max) buffer)))
     (when (interactive-p)
       (message "Buffer has %d words" words))
@@ -580,7 +580,7 @@
   "Print the number of words in region between START and END in BUFFER.
 If called noninteractively, the value is returned rather than printed.
 BUFFER defaults to the current buffer."
-  (interactive "r")
+  (interactive "_r")
   (save-excursion
     (set-buffer (or buffer (current-buffer)))
     (let ((words 0))
@@ -610,36 +610,71 @@
                cnt (- (point-max) (point-min)))
       cnt)))
 
+;;; Modified by Bob Weiner, 8/24/95, to print narrowed line number also.
+;;; Expanded by Bob Weiner, Altrasoft, on 02/12/1997
 (defun what-line ()
-  "Print the current buffer line number and narrowed line number of point."
+  "Print the following variants of the line number of point:
+     Region line     - displayed line within the active region
+     Collapsed line  - includes only selectively displayed lines;
+     Buffer line     - physical line in the buffer;
+     Narrowed line   - line number from the start of the buffer narrowing."
   ;; XEmacs change
   (interactive "_")
   (let ((opoint (point)) start)
     (save-excursion
       (save-restriction
-	(goto-char (point-min))
+	(if (region-active-p)
+	    (goto-char (region-beginning))
+	  (goto-char (point-min)))
 	(widen)
 	(beginning-of-line)
 	(setq start (point))
 	(goto-char opoint)
 	(beginning-of-line)
-	(if (/= start 1)
-	    (message "Line %d (narrowed line %d)"
-		     (1+ (count-lines 1 (point)))
-		     (1+ (count-lines start (point))))
-	  (message "Line %d" (1+ (count-lines 1 (point)))))))))
-
-
-(defun count-lines (start end)
+	(let* ((buffer-line (1+ (count-lines 1 (point))))
+	       (narrowed-p (or (/= start 1)
+			       (/= (point-max) (1+ (buffer-size)))))
+	       (narrowed-line (if narrowed-p (1+ (count-lines start (point)))))
+	       (selective-line (if selective-display
+				   (1+ (count-lines start (point) t))))
+	       (region-line (if (region-active-p)
+				(1+ (count-lines start (point) selective-display)))))
+	  (cond (region-line
+		 (message "Region line %d; Buffer line %d"
+			  region-line buffer-line))
+		((and narrowed-p selective-line (/= selective-line narrowed-line))
+		 ;; buffer narrowed and some lines selectively displayed
+		 (message "Collapsed line %d; Buffer line %d; Narrowed line %d"
+			  selective-line buffer-line narrowed-line))
+		(narrowed-p
+		 ;; buffer narrowed
+		 (message "Buffer line %d; Narrowed line %d"
+			  buffer-line narrowed-line))
+		((and selective-line (/= selective-line buffer-line))
+		 ;; some lines selectively displayed
+		 (message "Collapsed line %d; Buffer line %d"
+			  selective-line buffer-line))
+		(t
+		 ;; give a basic line count
+		 (message "Line %d" buffer-line)))))))
+  (setq zmacs-region-stays t))
+
+;;; Bob Weiner, Altrasoft, 02/12/1998
+;;; Added the 3rd arg in `count-lines' to conditionalize the counting of
+;;; collapsed lines.
+(defun count-lines (start end &optional ignore-invisible-lines-flag)
   "Return number of lines between START and END.
 This is usually the number of newlines between them,
 but can be one more if START is not equal to END
-and the greater of them is not at the start of a line."
+and the greater of them is not at the start of a line.
+
+With optional IGNORE-INVISIBLE-LINES-FLAG non-nil, lines collapsed with
+selective-display are excluded from the line count."
   (save-excursion
     (save-restriction
       (narrow-to-region start end)
       (goto-char (point-min))
-      (if (eq selective-display t)
+      (if (and (not ignore-invisible-lines-flag) (eq selective-display t))
 	  (save-match-data
 	    (let ((done 0))
 	      (while (re-search-forward "[\n\C-m]" nil t 40)
@@ -2762,7 +2797,7 @@
     ;; fa-extras, which I'm not gonna do.  His changes are to (1) execute
     ;; the save-excursion below unconditionally, and (2) uncomment the check
     ;; for (not comment-multi-line) further below.  --Stig
-      ;;### jhod: probably need to fix this for kinsoku processing
+      ;;#### jhod: probably need to fix this for kinsoku processing
       (if (not comment-multi-line)
 	  (save-excursion
 	    (if (and comment-start-skip
@@ -3603,12 +3638,23 @@
 For use on `remove-message-hook'."
   (when (and (not noninteractive)
 	     (funcall log-message-filter-function label message))
-    (with-current-buffer (get-buffer-create " *Message-Log*")
+    ;; Use save-excursion rather than save-current-buffer because we
+    ;; change the value of point.
+    (save-excursion
+      (set-buffer (get-buffer-create " *Message-Log*"))
       (goto-char (point-max))
-      ;; (insert (concat (upcase (symbol-name label)) ": "  message "\n"))
-      (insert message "\n")
+      ;(insert (concat (upcase (symbol-name label)) ": "  message "\n"))
+      (let (extent)
+	;; Mark multiline message with an extent, which `view-lossage'
+	;; will recognize.
+	(when (string-match "\n" message)
+	  (setq extent (make-extent (point) (point)))
+	  (set-extent-properties extent '(end-open nil message-multiline t)))
+	(insert message "\n")
+	(when extent
+	  (set-extent-property extent 'end-open t)))
       (when (> (point-max) (max log-message-max-size (point-min)))
-	;; trim log to ~90% of max size
+	;; Trim log to ~90% of max size.
 	(goto-char (max (- (point-max)
 			   (truncate (* 0.9 log-message-max-size)))
 			(point-min)))
@@ -3644,10 +3690,9 @@
   (or frame (setq frame (selected-frame)))
   (let ((clear-stream (and message-stack (eq 'stream (frame-type frame)))))
     (remove-message label frame)
-    (let ((buffer (get-buffer " *Echo Area*"))
-	  (inhibit-read-only t)
+    (let ((inhibit-read-only t)
 	  (zmacs-region-stays zmacs-region-stays)) ; preserve from change
-      (erase-buffer buffer))
+      (erase-buffer " *Echo Area*"))
     (if clear-stream
 	(send-string-to-terminal ?\n stdout-p))
     (if no-restore
@@ -3656,7 +3701,8 @@
 	  (let ((oldmsg (cdr (car message-stack))))
 	    (raw-append-message oldmsg frame stdout-p)
 	    oldmsg)
-	;; ### should we (redisplay-echo-area) here?  messes some things up.
+	;; #### Should we (redisplay-echo-area) here?  Messes some
+	;; things up.
 	nil))))
 
 (defun remove-message (&optional label frame)
@@ -3666,14 +3712,14 @@
     (while (and message-stack
 		(or (null label)	; null label means clear whole stack
 		    (eq label (car (car message-stack)))))
-      (setq log (cons (car message-stack) log))
-    (setq message-stack (cdr message-stack)))
+      (push (car message-stack) log)
+      (setq message-stack (cdr message-stack)))
     (let ((s  message-stack))
       (while (cdr s)
 	(let ((msg (car (cdr s))))
 	  (if (eq label (car msg))
 	      (progn
-		(setq log (cons msg log))
+		(push msg log)
 		(setcdr s (cdr (cdr s))))
 	    (setq s (cdr s))))))
     ;; (possibly) log each removed message
@@ -3686,27 +3732,26 @@
 		 "Error caught in `remove-message-hook': %s"
 		 (error-message-string e))
 	       (let ((inhibit-read-only t))
-		 (erase-buffer (get-buffer " *Echo Area*")))
+		 (erase-buffer " *Echo Area*"))
 	       (signal (car e) (cdr e))))
       (setq log (cdr log)))))
 
 (defun append-message (label message &optional frame stdout-p)
   (or frame (setq frame (selected-frame)))
-  ;; add a new entry to the message-stack, or modify an existing one
+  ;; Add a new entry to the message-stack, or modify an existing one
   (let ((top (car message-stack)))
     (if (eq label (car top))
 	(setcdr top (concat (cdr top) message))
-      (setq message-stack (cons (cons label message) message-stack))))
+      (push (cons label message) message-stack)))
   (raw-append-message message frame stdout-p))
 
-;; really append the message to the echo area.  no fiddling with message-stack.
+;; Really append the message to the echo area.  no fiddling with
+;; message-stack.
 (defun raw-append-message (message &optional frame stdout-p)
-  (if (eq message "") nil
-    (let ((buffer (get-buffer " *Echo Area*"))
+  (unless (equal message "")
+    (let ((inhibit-read-only t)
 	  (zmacs-region-stays zmacs-region-stays)) ; preserve from change
-      (with-current-buffer buffer
-	(let ((inhibit-read-only t))
-	  (insert message)))
+      (insert-string message " *Echo Area*")
       ;; Conditionalizing on the device type in this way is not that clean,
       ;; but neither is having a device method, as I originally implemented
       ;; it: all non-stream devices behave in the same way.  Perhaps
@@ -3718,7 +3763,7 @@
       ;; Don't redisplay the echo area if we are executing a macro.
       (if (not executing-kbd-macro)
 	  (if (eq 'stream (frame-type frame))
-	      (send-string-to-terminal message stdout-p)
+	      (send-string-to-terminal message stdout-p (frame-device frame))
 	    (redisplay-echo-area))))))
 
 (defun display-message (label message &optional frame stdout-p)
@@ -3894,8 +3939,7 @@
   (check-argument-type 'warning-level-p level)
   (if (and (not (featurep 'infodock))
 	   (not init-file-loaded))
-      (setq before-init-deferred-warnings
-	    (cons (list class message level) before-init-deferred-warnings))
+      (push (list class message level) before-init-deferred-warnings)
     (catch 'ignored
       (let ((display-p t)
 	    (level-num (cdr (assq level warning-level-alist))))