Mercurial > hg > xemacs-beta

changeset 2510:6f72d9a709c3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-01-26 09:56:05 by ben] Sync to FSF fill.el: Sync for real to FSF 19.34. page.el, register.el: Sync to FSF 21.3.
author ben
date Wed, 26 Jan 2005 09:56:06 +0000
parents 6a9afa282c8e
children b9a1074dc6bf
files lisp/ChangeLog lisp/fill.el lisp/page.el lisp/register.el
diffstat 4 files changed, 143 insertions(+), 95 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Wed Jan 26 09:53:32 2005 +0000
+++ b/lisp/ChangeLog	Wed Jan 26 09:56:06 2005 +0000
@@ -1,3 +1,25 @@
+2005-01-26  Ben Wing  <ben@xemacs.org>
+
+	* fill.el:
+	* fill.el (canonically-space-region):
+	* fill.el (fill-region-as-paragraph):
+	* fill.el (justify-current-line):
+	* fill.el (fill-individual-paragraphs):
+	Sync for real to FSF 19.34.
+
+	* page.el:
+	* page.el (narrow-to-page):
+	* register.el:
+	* register.el (set-register):
+	* register.el (point-to-register):
+	* register.el (register-swap-out):
+	* register.el (number-to-register):
+	* register.el (view-register):
+	* register.el (list-registers): New.
+	* register.el (describe-register-1): New.
+	* register.el (insert-register):
+	Sync to FSF 21.3.
+
 2005-01-26  Ben Wing  <ben@xemacs.org>
 
 	* frame.el (display-mouse-p):
@@ -18,13 +40,6 @@
 
 2004-11-17  Ben Wing  <ben@xemacs.org>
 
-	* fill.el:
-	* fill.el (canonically-space-region):
-	* fill.el (fill-region-as-paragraph):
-	* fill.el (justify-current-line):
-	* fill.el (fill-individual-paragraphs):
-	Sync for real to FSF 19.34.
-	
 	* newcomment.el:
 	* newcomment.el (comment):
 	* newcomment.el (comment-fill-column): New.
@@ -44,18 +59,6 @@
 	* newcomment.el (comment-auto-fill-only-comments):
 	* newcomment.el (comment-valid-prefix): New.
 	* newcomment.el (comment-indent-new-line):
-	* page.el:
-	* page.el (narrow-to-page):
-	* register.el:
-	* register.el (set-register):
-	* register.el (point-to-register):
-	* register.el (register-swap-out):
-	* register.el (number-to-register):
-	* register.el (view-register):
-	* register.el (list-registers): New.
-	* register.el (describe-register-1): New.
-	* register.el (insert-register):
-	Sync to FSF 21.3.
 
 2005-01-25  Ben Wing  <ben@xemacs.org>
 
--- a/lisp/fill.el	Wed Jan 26 09:53:32 2005 +0000
+++ b/lisp/fill.el	Wed Jan 26 09:56:06 2005 +0000
@@ -23,6 +23,10 @@
 ;; 02111-1307, USA.
 
 ;;; Synched up with: FSF 19.34.
+;;; NOTE: Merging past 19.34 is currently impossible.  Later versions
+;;; contain FSF's own Kinsoku processing, conflicting with the current code
+;;; and depending on various features of their Mule implementation that
+;;; do not currently exist.
 
 ;;; Commentary:
 
@@ -201,9 +205,7 @@
       ;; We insert before markers in case a caller such as
       ;; do-auto-fill has done a save-excursion with point at the end
       ;; of the line and wants it to stay at the end of the line.
-      (insert ? ))))
-;; XEmacs: we don't have this function.
-;; (insert-before-markers-and-inherit ? ))))
+      (insert-before-markers-and-inherit ? ))))
 
 ;; XEmacs -- added DONT-SKIP-FIRST.  Port of older code changes by Stig.
 ;; #### probably this junk is broken -- do-auto-fill doesn't actually use
@@ -377,8 +379,7 @@
 	  ;; Make sure sentences ending at end of line get an extra space.
 	  ;; loses on split abbrevs ("Mr.\nSmith")
 	  (while (re-search-forward "[.?!][])}\"']*$" nil t)
-	    ;; XEmacs change (no insert-and-inherit)
-	    (or (eobp) (insert ?\  ?\ )))
+	    (or (eobp) (insert-and-inherit ?\  ?\ )))
 	  (goto-char from)
 	  (skip-chars-forward " \t")
 	  ;; Then change all newlines to spaces.
@@ -423,8 +424,7 @@
 	    (canonically-space-region (or squeeze-after (point)) (point-max))
 	    (goto-char (point-max))
 	    (delete-horizontal-space)
-	    ;; XEmacs change (no insert-and-inherit)
-	    (insert " "))
+	    (insert-and-inherit " "))
 	  (goto-char (point-min))
 
 	  ;; This is the actual filling loop.
@@ -572,7 +572,7 @@
 		  ;; Set prefixcol so whitespace in the prefix won't get lost.
 		  (and fill-prefix (not (equal fill-prefix ""))
 		       (progn
-			 (insert fill-prefix)
+			 (insert-and-inherit fill-prefix)
 			 (setq prefixcol (current-column))))))
 	      ;; Justify the line just ended, if desired.
 	      (if justify
@@ -930,8 +930,7 @@
 				       (find-space-insertable-point))) ;(search-backward " ")))
 				 (skip-chars-backward " ")
 				 (setq nmove (1- nmove))))
-			     ;; XEmacs change
-			     (insert " ")
+			     (insert-and-inherit " ")
 			     (skip-chars-backward " ")
 			     (setq ncols (1- ncols)))))))
 		(t (error "Unknown justification value"))))
@@ -1046,7 +1045,7 @@
 			     fill-prefix-regexp (regexp-quote fill-prefix)))
 		   (forward-line 1)
 		   (if (bolp)
-		       ;; If forward-line went past a newline
+		       ;; If forward-line went past a newline,
 		       ;; move further to the left margin.
 		       (move-to-left-margin))
 		   ;; Now stop the loop if end of paragraph.
--- a/lisp/page.el	Wed Jan 26 09:53:32 2005 +0000
+++ b/lisp/page.el	Wed Jan 26 09:56:06 2005 +0000
@@ -1,9 +1,10 @@
-;;; page.el --- page motion commands for emacs.
+;;; page.el --- page motion commands for Emacs
 
 ;; Copyright (C) 1985, 1997 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: extensions, dumped
+;; Keywords: wp convenience
 
 ;; This file is part of XEmacs.
 
@@ -22,7 +23,7 @@
 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; 02111-1307, USA.
 
-;;; Synched up with: FSF 19.34.
+;;; Synched up with: FSF 21.3.
 
 ;;; Commentary:
 
@@ -94,15 +95,28 @@
     (if (> arg 0)
 	(forward-page arg)
       (if (< arg 0)
-	  (forward-page (1- arg))))
+	  (let ((adjust 0)
+		(opoint (point)))
+	    ;; If we are not now at the beginning of a page,
+	    ;; move back one extra time, to get to the start of this page.
+	    (save-excursion
+	      (beginning-of-line)
+	      (or (and (looking-at page-delimiter)
+		       (eq (match-end 0) opoint))
+		  (setq adjust 1)))
+	    (forward-page (- arg adjust)))))
     ;; Find the end of the page.
+    (set-match-data nil)
     (forward-page)
     ;; If we stopped due to end of buffer, stay there.
     ;; If we stopped after a page delimiter, put end of restriction
     ;; at the beginning of that line.
-    (if (save-excursion
-	  (goto-char (match-beginning 0)) ; was (beginning-of-line)
-	  (looking-at page-delimiter))
+    ;; Before checking the match that was found,
+    ;; verify that forward-page actually set the match data.
+    (if (and (match-beginning 0)
+	     (save-excursion
+	       (goto-char (match-beginning 0)) ; was (beginning-of-line)
+	       (looking-at page-delimiter)))
 	(beginning-of-line))
     (narrow-to-region (point)
 		      (progn
--- a/lisp/register.el	Wed Jan 26 09:53:32 2005 +0000
+++ b/lisp/register.el	Wed Jan 26 09:56:06 2005 +0000
@@ -1,4 +1,4 @@
-;;; register.el --- register commands for Emacs.
+;;; register.el --- register commands for Emacs
 
 ;; Copyright (C) 1985, 1993, 1994, 1997 Free Software Foundation, Inc.
 
@@ -22,7 +22,7 @@
 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
 ;; 02111-1307, USA.
 
-;;; Synched up with: FSF 20.3
+;;; Synched up with: FSF 21.3
 
 ;;; Commentary:
 
@@ -57,8 +57,7 @@
   (let ((aelt (assq register register-alist)))
     (if aelt
 	(setcdr aelt value)
-      (setq aelt (cons register value))
-      (setq register-alist (cons aelt register-alist)))
+      (push (cons register value) register-alist))
     value))
 
 (defun point-to-register (register &optional arg)
@@ -67,6 +66,8 @@
 Use \\[jump-to-register] to go to that location or restore that configuration.
 Argument is a character, naming the register."
   (interactive "cPoint to register: \nP")
+  ;; Turn the marker into a file-ref if the buffer is killed.
+  (add-hook 'kill-buffer-hook 'register-swap-out nil t)
   (set-register register
 		(if arg (list (current-frame-configuration) (point-marker))
 		  (point-marker))))
@@ -125,20 +126,16 @@
      (t
       (error "Register doesn't contain a buffer position or configuration")))))
 
-;; Turn markers into file-query references when a buffer is killed.
 (defun register-swap-out ()
+  "Turn markers into file-query references when a buffer is killed."
   (and buffer-file-name
-       (let ((tail register-alist))
-	 (while tail
-	   (and (markerp (cdr (car tail)))
-		(eq (marker-buffer (cdr (car tail))) (current-buffer))
-		(setcdr (car tail)
-			(list 'file-query
-			      buffer-file-name
-			      (marker-position (cdr (car tail))))))
-	   (setq tail (cdr tail))))))
-
-(add-hook 'kill-buffer-hook 'register-swap-out)
+       (dolist (elem register-alist)
+	 (and (markerp (cdr elem))
+	      (eq (marker-buffer (cdr elem)) (current-buffer))
+	      (setcdr elem
+		      (list 'file-query
+			    buffer-file-name
+			    (marker-position (cdr elem))))))))
 
 (defun number-to-register (number register)
   "Store a number in a register.
@@ -147,7 +144,7 @@
 at point, and point moves to the end of that number.
 Interactively, NUMBER is the prefix arg (none means nil)."
   (interactive "P\ncNumber to register: ")
-  (set-register register 
+  (set-register register
 		(if number
 		    (prefix-numeric-value number)
 		  (if (looking-at "\\s-*-?[0-9]+")
@@ -172,54 +169,89 @@
     (if (null val)
 	(message "Register %s is empty" (single-key-description register))
       (with-output-to-temp-buffer "*Output*"
-	(princ "Register ")
-	(princ (single-key-description register))
-	(princ " contains ")
-	(cond
-	 ((numberp val)
-	  (princ val))
+	(describe-register-1 register t)))))
+
+(defun list-registers ()
+  "Display a list of nonempty registers saying briefly what they contain."
+  (interactive)
+  (let ((list (copy-sequence register-alist)))
+    (setq list (sort list (lambda (a b) (< (car a) (car b)))))
+    (with-output-to-temp-buffer "*Output*"
+      (dolist (elt list)
+	(when (get-register (car elt))
+	  (describe-register-1 (car elt))
+	  (terpri))))))
 
-	 ((markerp val)
-	  (let ((buf (marker-buffer val)))
-	    (if (null buf)
-		(princ "a marker in no buffer")
-	      (princ "a buffer position:\nbuffer ")
-	      (princ (buffer-name buf))
-	      (princ ", position ")
-	      (princ (marker-position val)))))
+(defun describe-register-1 (register &optional verbose)
+  (princ "Register ")
+  (princ (single-key-description register))
+  (princ " contains ")
+  (let ((val (get-register register)))
+    (cond
+     ((numberp val)
+      (princ val))
 
-	 ((and (consp val) (window-configuration-p (car val)))
-	  (princ "a window configuration."))
+     ((markerp val)
+      (let ((buf (marker-buffer val)))
+	(if (null buf)
+	    (princ "a marker in no buffer")
+	  (princ "a buffer position:\n    buffer ")
+	  (princ (buffer-name buf))
+	  (princ ", position ")
+	  (princ (marker-position val)))))
 
-	 ((and (consp val) (frame-configuration-p (car val)))
-	  (princ "a frame configuration."))
+     ((and (consp val) (window-configuration-p (car val)))
+      (princ "a window configuration."))
+
+     ((and (consp val) (frame-configuration-p (car val)))
+      (princ "a frame configuration."))
+
+     ((and (consp val) (eq (car val) 'file))
+      (princ "the file ")
+      (prin1 (cdr val))
+      (princ "."))
 
-	 ((and (consp val) (eq (car val) 'file))
-	  (princ "the file ")
-	  (prin1 (cdr val))
-	  (princ "."))
+     ((and (consp val) (eq (car val) 'file-query))
+      (princ "a file-query reference:\n    file ")
+      (prin1 (car (cdr val)))
+      (princ ",\n    position ")
+      (princ (car (cdr (cdr val))))
+      (princ "."))
 
-	 ((and (consp val) (eq (car val) 'file-query))
-	  (princ "a file-query reference:\nfile ")
-	  (prin1 (car (cdr val)))
-	  (princ ",\nposition ")
-	  (princ (car (cdr (cdr val))))
-	  (princ "."))
+     ((consp val)
+      (if verbose
+	  (progn
+	    (princ "the rectangle:\n")
+	    (while val
+	      (princ "    ")
+	      (princ (car val))
+	      (terpri)
+	      (setq val (cdr val))))
+	(princ "a rectangle starting with ")
+	(princ (car val))))
 
-	 ((consp val)
-	  (princ "the rectangle:\n")
-	  (while val
-	    (princ (car val))
-	    (terpri)
-	    (setq val (cdr val))))
-
-	 ((stringp val)
-	  (princ "the text:\n")
-	  (princ val))
-
+     ((stringp val)
+      (remove-list-of-text-properties 0 (length val)
+                                      yank-excluded-properties val)
+      (if verbose
+	  (progn
+	    (princ "the text:\n")
+	    (princ val))
+	(cond
+	 ;; Extract first N characters starting with first non-whitespace.
+	 ((string-match (format "[^ \t\n].\\{,%d\\}"
+				;; Deduct 6 for the spaces inserted below.
+				(min 20 (max 0 (- (window-width) 6))))
+			val)
+	  (princ "text starting with\n    ")
+	  (princ (match-string 0 val)))
+	 ((string-match "^[ \t\n]+$" val)
+	  (princ "whitespace"))
 	 (t
-	  (princ "Garbage:\n")
-	  (prin1 val)))))))
+	  (princ "the empty string")))))
+     (t
+      (princ "Garbage:\n")
+      (if verbose (prin1 val))))))
 
 (defun insert-register (register &optional arg)
   "Insert contents of register REGISTER.  (REGISTER is a character.)
@@ -233,7 +265,7 @@
      ((consp val)
       (insert-rectangle val))
      ((stringp val)
-      (insert val))
+      (insert-for-yank val))
      ((numberp val)
       (princ val (current-buffer)))
      ((and (markerp val) (marker-position val))