[COMMIT] Sync to FSF

NOTE: This patch has been committed. lisp/ChangeLog addition: 2005-01-26 Ben Wing <ben(a)xemacs.org&gt; * 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. symlink source patch: Diff command: bash -ci "cvs-diff --show-c-function -no-changelog " Files affected: lisp/register.el lisp/page.el lisp/fill.el Index: lisp/fill.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/fill.el,v retrieving revision 1.7 diff -u -p -r1.7 fill.el --- lisp/fill.el 2002/03/15 07:43:19 1.7 +++ lisp/fill.el 2005/01/26 09:55:12 ＠＠ -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 ＠＠ Remove indentation from each line." ;; 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 ＠＠ space does not end a sentence, so don't ;; 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 ＠＠ space does not end a sentence, so don't (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 ＠＠ space does not end a sentence, so don't ;; 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 ＠＠ otherwise it is made canonical." (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 ＠＠ MAIL-FLAG for a mail message, i. e. don' 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. Index: lisp/page.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/page.el,v retrieving revision 1.3 diff -u -p -r1.3 page.el --- lisp/page.el 2001/04/12 18:21:34 1.3 +++ lisp/page.el 2005/01/26 09:55:14 ＠＠ -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 ＠＠ thus showing a page other than the one p (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 Index: lisp/register.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/lisp/register.el,v retrieving revision 1.7 diff -u -p -r1.7 register.el --- lisp/register.el 1998/07/12 07:30:39 1.7 +++ lisp/register.el 2005/01/26 09:55:15 ＠＠ -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 ＠＠ See the documentation of the variable `r (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 ＠＠ With prefix argument, store current fram 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,21 +126,17 ＠＠ delete any existing frames that the fram (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)))))) + (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)))))))) -(add-hook 'kill-buffer-hook 'register-swap-out) - (defun number-to-register (number register) "Store a number in a register. Two args, NUMBER and REGISTER (a character, naming the register). ＠＠ -147,7 +144,7 ＠＠ If NUMBER is nil, a decimal number is re 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 ＠＠ The Lisp value REGISTER is a character." (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)))))) + +(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)) + + ((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) (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:\nbuffer ") - (princ (buffer-name buf)) - (princ ", position ") - (princ (marker-position val))))) - - ((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-query)) - (princ "a file-query reference:\nfile ") - (prin1 (car (cdr val))) - (princ ",\nposition ") - (princ (car (cdr (cdr val)))) - (princ ".")) - - ((consp val) - (princ "the rectangle:\n") - (while val - (princ (car val)) - (terpri) - (setq val (cdr val)))) - - ((stringp val) - (princ "the text:\n") - (princ val)) + ((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-query)) + (princ "a file-query reference:\n file ") + (prin1 (car (cdr val))) + (princ ",\n position ") + (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)))) + + ((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 ＠＠ Interactively, second arg is non-nil if ((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))