Mercurial > emacs
changeset 83113:1a68e4b22355
Merged in changes from CVS trunk.
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-241
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-242
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-243
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-244
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-245
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-246
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-247
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-248
src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-249
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-250
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-251
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-252
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-253
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-254
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-255
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-153
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Tue, 27 Apr 2004 15:53:30 +0000 |
| parents | 30dd490f06f2 (current diff) b4f51693f2db (diff) |
| children | 0c11f1f77626 |
| files | ChangeLog lisp/ChangeLog lisp/simple.el lisp/vc-hooks.el lisp/vc.el src/alloc.c src/buffer.c src/dispextern.h src/lisp.h src/lread.c src/macterm.c src/print.c src/xdisp.c src/xfaces.c src/xterm.c |
| diffstat | 47 files changed, 2029 insertions(+), 534 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Fri Apr 23 14:44:11 2004 +0000 +++ b/ChangeLog Tue Apr 27 15:53:30 2004 +0000 @@ -1,3 +1,7 @@ +2004-04-24 Thien-Thi Nguyen <ttn@gnu.org> + + * autogen.sh: Update filename in "please read" message. + 2004-04-17 Richard M. Stallman <rms@gnu.org> * INSTALL: Move the info about site-lisp dirs,
--- a/MAINTAINERS Fri Apr 23 14:44:11 2004 +0000 +++ b/MAINTAINERS Tue Apr 27 15:53:30 2004 +0000 @@ -19,9 +19,6 @@ Richard Stallman ??? -Andrew Choi - MacOS - Jason Rumney W32 @@ -73,6 +70,9 @@ 2. ============================================================================== +Steven Tamm + MacOS + Eli Zaretskii man/* lispref/*
--- a/autogen.sh Fri Apr 23 14:44:11 2004 +0000 +++ b/autogen.sh Tue Apr 27 15:53:30 2004 +0000 @@ -1,6 +1,6 @@ #!/bin/sh -echo "Please read INSTALL-CVS for instructions on how to build Emacs from CVS." +echo "Please read INSTALL.CVS for instructions on how to build Emacs from CVS." # Exit with failure, since people may have generic build scripts that # try things like "autogen.sh && ./configure && make".
--- a/etc/NEWS Fri Apr 23 14:44:11 2004 +0000 +++ b/etc/NEWS Tue Apr 27 15:53:30 2004 +0000 @@ -4,6 +4,8 @@ Please send Emacs bug reports to bug-gnu-emacs@gnu.org. For older news, see the file ONEWS +You can narrow news to the specific version by calling +`view-emacs-news' with a prefix argument or by typing C-u C-h C-n. Temporary note: +++ indicates that the appropriate manual has already been updated. @@ -88,6 +90,10 @@ * Changes in Emacs 21.4 +--- +** The IELM prompt is now, by default, read-only. This can be +controlled with the new user option `ielm-prompt-read-only'. + ** You can now use next-error (C-x `) and previous-error to advance to the next/previous matching line found by M-x occur. @@ -1984,9 +1990,35 @@ *** New function insert-sliced-image inserts a given image as a specified number of evenly sized slices (rows x columns). -*** Trailing newlines no longer contribute to the height of a display -row; instead the height of the newline glyph is reduced. This allows -sliced images to use a height less than the default line height. +** New line-height and line-spacing properties for newline characters + +A newline may now have line-height and line-spacing text properties that +control the height of the corresponding display row. + +If the line-height property value is 0, the newline does not +contribute to the height of the display row; instead the height of the +newline glyph is reduced. This can be used to tile small images or +image slices without adding blank areas between the images. + +If the line-height property value is a positive integer, the value +specifies the minimum line height in pixels. If necessary, the line +height it increased by increasing the line's ascent. + +If the line-height property value is a float, the minimum line height +is calculated by multiplying the height of the current face font by +the given value. + +If the line-height property value is t, the minimum line height is +the height of the default frame font. + +If the line-spacing property value is an integer, the value is used as +additional space to put after the display line; this overrides the +default frame line-spacing and any buffer local value of the +line-spacing variable. + +If the line-spacing property value is a float, the value is multiplied +by the current height of the display row to determine the additional +space to put after the display line. ** Enhancements to stretch display properties
--- a/etc/compilation.txt Fri Apr 23 14:44:11 2004 +0000 +++ b/etc/compilation.txt Tue Apr 27 15:53:30 2004 +0000 @@ -120,6 +120,7 @@ symbol: irix ccom: Error: foo.c, line 2: syntax error +cc: Severe: /src/Python-2.3.3/Modules/_curses_panel.c, line 17: Cannot find file <panel.h> ... cc: Info: foo.c, line 27: ... cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ... cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ...
--- a/lib-src/ChangeLog Fri Apr 23 14:44:11 2004 +0000 +++ b/lib-src/ChangeLog Tue Apr 27 15:53:30 2004 +0000 @@ -1,3 +1,9 @@ +2004-04-26 Eli Zaretskii <eliz@gnu.org> + + * make-docfile.c (IS_DIRECTORY_SEP): New macro. + (put_filename): Remove unused variable len. Use IS_DIRECTORY_SEP + instead of a literal '/'. + 2004-04-23 Juanma Barranquero <lektu@terra.es> * makefile.w32-in: Add "-*- makefile -*-" mode tag.
--- a/lib-src/make-docfile.c Fri Apr 23 14:44:11 2004 +0000 +++ b/lib-src/make-docfile.c Tue Apr 27 15:53:30 2004 +0000 @@ -60,6 +60,10 @@ #define READ_BINARY "r" #endif /* not DOS_NT */ +#ifndef IS_DIRECTORY_SEP +#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/') +#endif + int scan_file (); int scan_lisp_file (); int scan_c_file (); @@ -183,11 +187,13 @@ put_filename (filename) char *filename; { - char *tmp = filename; - int len; - - while ((tmp = index (filename, '/'))) - filename = tmp + 1; + char *tmp; + + for (tmp = filename; *tmp; tmp++) + { + if (IS_DIRECTORY_SEP(*tmp)) + filename = tmp + 1; + } putc (037, outfile); putc ('S', outfile);
--- a/lisp/ChangeLog Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/ChangeLog Tue Apr 27 15:53:30 2004 +0000 @@ -1,3 +1,160 @@ +2004-04-27 Juri Linkov <juri@jurta.org> + + * help.el (view-emacs-news): With argument, display info for the + selected version by finding it among different NEWS files, and + narrowing the buffer to the selected version. + + * info.el: Add *info*<[0-9]+> to same-window-regexps instead of + same-window-buffer-names. + (info): New arg `buffer'. Use it. Doc fix. Read file name for + non-numeric prefix argument, append the number to the buffer name + for numeric prefix argument. + (info-other-window): Bind same-window-regexps to nil. + (Info-reference-name): Rename to Info-point-loc. + (Info-find-node-2): Call forward-line for numeric Info-point-loc, + and Info-find-index-name for stringy Info-point-loc. + (Info-extract-menu-node-name): New arg `index-node'. Use regexp + without middle `.', but with final `.' and optional line number + for it. Set Info-point-loc for index nodes. + (Info-index): Remove middle `.' from index entry regexp. + Modify line number regexp. + (Info-index-next): Decrement line number. + (info-apropos): Remove middle `.' from index entry regexp. + Add optional line number regexp at the end. Add matched value + for line number to the result list and insert it to the buffer. + Replace match-string by match-string-no-properties. + Reorder result list. + (Info-fontify-node): Hide index line numbers. + (Info-goto-node): Replace "\\s *\\'" by "\\s +\\'" to not trim + empty matches. + (Info-follow-reference): Use `str' instead of + Info-following-node-name-re. + (Info-toc): Use full file names. Set Info-current-node to "Top". + (Info-fontify-node): Compare file names without directory name. + (Info-try-follow-nearest-node): Don't set Info-reference-name. + Set second arg of Info-extract-menu-node-name for index nodes. + (info-xref-visited): Use magenta3 instead of magenta4. + (Info-mode): Add info-apropos to docstring. + + * log-view.el (log-view-diff): Replace interactive code "r" + by a list to allow to call it even if region is not active. + + * paren.el (show-paren-highlight-openparen): New var. + (show-paren-function): Turn on openparen highlighting when + matching forward if show-paren-highlight-openparen is non-nil. + + * simple.el (kill-ring-save): Use blink-matching-delay instead of + the constant value 1. + (completions-common-part): Expand docstring. + + * textmodes/picture.el (picture-mode-map): Add arrow keys. + +2004-04-27 Kim F. Storm <storm@cua.dk> + + * image.el (insert-sliced-image): Use line-height instead of + line-spacing property on newline. + +2004-04-26 Lars Hansen <larsh@math.ku.dk> + + * desktop.el (desktop-buffer-misc-data-function): Rename to + desktop-save-buffer and change docstring. + (desktop-buffer-modes-to-save): Delete. + (desktop-save-buffer-p): Use desktop-save-buffer instead of + desktop-buffer-modes-to-save. + (desktop-save): Rename desktop-buffer-misc-data-function to + desktop-save-buffer and allow non-function value. + (desktop-missing-file-warning): Correct docstring. + + * dired.el (dired-mode): Rename desktop-buffer-misc-data-function + to desktop-save-buffer. + + * info.el (Info-mode): Rename desktop-buffer-misc-data-function to + desktop-save-buffer. + + * mail/rmail.el (rmail-variables): Bind desktop-save-buffer to t. + + * mh-e/mh-e.el (mh-folder-mode): Bind desktop-save-buffer to t. + +2004-04-26 Eli Zaretskii <eliz@gnu.org> + + * progmodes/gud.el (gud-pdb-command-name): Change default to + "pydb". + + +2004-04-25 Luc Teirlinck <teirllm@auburn.edu> + + * ielm.el (ielm-prompt-read-only, ielm-prompt): Expand docstring. + (ielm): Only go to the end of the buffer when starting a new process. + +2004-04-25 Juanma Barranquero <lektu@terra.es> + + * ielm.el (inferior-emacs-lisp-mode): Display working buffer on the + mode line. Bind `inhibit-read-only' to t before modifying + properties of text in the buffer. + (ielm): Force point to the end of buffer, even when running ielm + from inside itself. + +2004-04-25 Jesper Harder <harder@ifa.au.dk> + + * info.el (info-apropos): Reset Info-complete-cache. + +2004-04-25 Daniel Pfeiffer <occitan@esperanto.org> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Also recognize severe Irix et al. messages. + (compilation-normalize-filename, compile-abbreviate-directory): + Delete functions. + (compilation-get-file-structure): New function inherits + functionality of the two preceding ones. + (compilation-internal-error-properties, compilation-fake-loc): Use + it so that different paths to the same file share the same + markers. Also optimize finding adjacent marker slightly. + +2004-04-25 Kim F. Storm <storm@cua.dk> + + * image.el (insert-sliced-image): Add line-spacing t property + to newlines separating image lines. + +2004-04-24 Luc Teirlinck <teirllm@auburn.edu> + + * comint.el (comint-delete-output): Bind inhibit-read-only to t. + + * ielm.el (ielm-prompt-read-only): New user option. + (ielm-prompt): Expand docstring to describe new behavior. + (inferior-emacs-lisp-mode): Implement ielm-prompt-read-only and + mention it in the docstring. + +2004-04-24 Andreas Schwab <schwab@suse.de> + + * progmodes/sh-script.el (sh-leading-keywords) <sh>: Add "!". + + * diff.el (diff): Set default-directory in diff buffer. + +2004-04-24 Eli Zaretskii <eliz@gnu.org> + + * mail/sendmail.el (mail-bury): Don't delete the frame where the + mail was being composed if the terminal cannot display more than + one frame; instead, switch to previous frame. + + * mail/rmail.el (rmail-mail-new-frame): Doc fix. + (rmail-start-mail): Support rmail-mail-new-frame even on + terminals that can display only one frame at a time. + +2004-04-23 Juanma Barranquero <lektu@terra.es> + + * ielm.el (inferior-emacs-lisp-mode): Fix docstring. + + * pcomplete.el (pcomplete-opt, pcomplete-actual-arg) + (pcomplete-match-string, pcomplete-comint-setup, pcomplete-here) + (pcomplete--help, pcomplete--here): Doc fixes. + +2004-04-23 Andre Spiegel <spiegel@gnu.org> + + * vc-hooks.el (vc-default-workfile-unchanged-p): Fix code that + handles wrong-number-of-arguments in backend call. + + * vc.el (vc-print-log): Likewise. + 2004-04-23 Kenichi Handa <handa@m17n.org> * international/mule-util.el (char-displayable-p): Simplified by @@ -121,9 +278,11 @@ Add parameters. Pause to display error only when desktop-missing-file-warning is non-nil. (dired-desktop-buffer-misc-data): Move from desktop.el. Add parameter. + (dired-mode): Bind desktop-buffer-misc-data-function. * info.el (Info-restore-desktop-buffer): Move from desktop.el. Add Parameters. (Info-desktop-buffer-misc-data): Move from desktop.el. Add parameter. + (Info-mode): Bind desktop-buffer-misc-data-function. * mail/rmail.el (rmail-restore-desktop-buffer): Move from desktop.el. Add Parameters. * mh-e/mh-e.el (mh-restore-desktop-buffer): Move from desktop.el.
--- a/lisp/comint.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/comint.el Tue Apr 27 15:53:30 2004 +0000 @@ -2006,7 +2006,8 @@ Does not delete the prompt." (interactive) (let ((proc (get-buffer-process (current-buffer))) - (replacement nil)) + (replacement nil) + (inhibit-read-only t)) (save-excursion (let ((pmark (progn (goto-char (process-mark proc)) (forward-line 0)
--- a/lisp/desktop.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/desktop.el Tue Apr 27 15:53:30 2004 +0000 @@ -145,8 +145,11 @@ :group 'desktop) (defcustom desktop-missing-file-warning nil - "*If non-nil then `desktop-read' warns when a file no longer exists. -Otherwise it simply ignores that file." + "*If non-nil then `desktop-read' asks if a non-existent file should be recreated. +Also pause for a moment to display message about errors signaled in +`desktop-buffer-mode-handlers'. + +If nil, just print error messages in the message buffer." :type 'boolean :group 'desktop) @@ -244,15 +247,6 @@ :type 'regexp :group 'desktop) -(defcustom desktop-buffer-modes-to-save - '(Info-mode rmail-mode) - "If a buffer is of one of these major modes, save the buffer state. -This applies to buffers not visiting a file and not beeing a dired buffer. -Modes specified here must have a handler in `desktop-buffer-mode-handlers' -to be restored." - :type '(repeat symbol) - :group 'desktop) - (defcustom desktop-modes-not-to-save nil "List of major modes whose buffers should not be saved." :type '(repeat symbol) @@ -268,21 +262,25 @@ :group 'desktop) ;;;###autoload -(defvar desktop-buffer-misc-data-function nil - "Function returning major mode specific data for desktop file. +(defvar desktop-save-buffer nil + "When non-nil, save buffer status in desktop file. This variable becomes buffer local when set. -The function specified is called by `desktop-save', with argument -DESKTOP-DIRNAME. If it returns non-nil, its value is saved along -with the state of the buffer for which it was called. + +If the value is a function, it called by `desktop-save' with argument +DESKTOP-DIRNAME to obtain auxiliary information to saved in the desktop +file along with the state of the buffer for which it was called. When file names are returned, they should be formatted using the call \"(desktop-file-name FILE-NAME DESKTOP-DIRNAME)\". Later, when `desktop-read' calls a function in `desktop-buffer-mode-handlers' -to restore the buffer, the auxiliary information is passed as argument.") -(make-variable-buffer-local 'desktop-buffer-misc-data-function) +to restore the buffer, the auxiliary information is passed as the argument +DESKTOP-BUFFER-MISC.") +(make-variable-buffer-local 'desktop-save-buffer) +(make-obsolete-variable 'desktop-buffer-modes-to-save + 'desktop-save-buffer) (make-obsolete-variable 'desktop-buffer-misc-functions - 'desktop-buffer-misc-data-function) + 'desktop-save-buffer) (defcustom desktop-buffer-mode-handlers '( (dired-mode . dired-restore-desktop-buffer) @@ -541,21 +539,20 @@ ;; ---------------------------------------------------------------------------- (defun desktop-save-buffer-p (filename bufname mode &rest dummy) - "Return t if the desktop should record a particular buffer for next startup. + "Return t if buffer should have its state saved in the desktop file. FILENAME is the visited file name, BUFNAME is the buffer name, and MODE is the major mode." (let ((case-fold-search nil)) (and (not (string-match desktop-buffers-not-to-save bufname)) - (not (memq mode desktop-modes-not-to-save)) - (or (and filename - (not (string-match desktop-files-not-to-save filename))) - (and (eq mode 'dired-mode) - (save-excursion - (set-buffer (get-buffer bufname)) - (not (string-match desktop-files-not-to-save - default-directory)))) - (and (null filename) - (memq mode desktop-buffer-modes-to-save)))))) + (not (memq mode desktop-modes-not-to-save)) + (or (and filename + (not (string-match desktop-files-not-to-save filename))) + (and (eq mode 'dired-mode) + (with-current-buffer bufname + (not (string-match desktop-files-not-to-save + default-directory)))) + (and (null filename) + (with-current-buffer bufname desktop-save-buffer)))))) ;; ---------------------------------------------------------------------------- (defun desktop-file-name (filename dirname) @@ -610,8 +607,8 @@ (list (mark t) mark-active) buffer-read-only ;; Auxiliary information - (when desktop-buffer-misc-data-function - (funcall desktop-buffer-misc-data-function dirname)) + (when (functionp desktop-save-buffer) + (funcall desktop-save-buffer dirname)) (let ((locals desktop-locals-to-save) (loclist (buffer-local-variables)) (ll)) @@ -813,8 +810,8 @@ nil))) ;; ---------------------------------------------------------------------------- -;; Create a buffer, load its file, set is mode, ...; called from Desktop file -;; only. +;; Create a buffer, load its file, set its mode, ...; +;; called from Desktop file only. (eval-when-compile ; Just to silence the byte compiler (defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read'
--- a/lisp/diff.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/diff.el Tue Apr 27 15:53:30 2004 +0000 @@ -111,6 +111,7 @@ ,(shell-quote-argument (or new-alt new))) " ")) (buf (get-buffer-create "*Diff*")) + (thisdir default-directory) proc) (save-excursion (display-buffer buf) @@ -125,6 +126,7 @@ (diff ',old ',new ',switches ',no-async))) (set (make-local-variable 'diff-old-temp-file) old-alt) (set (make-local-variable 'diff-new-temp-file) new-alt) + (setq default-directory thisdir) (insert command "\n") (if (and (not no-async) (fboundp 'start-process)) (progn
--- a/lisp/dired.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/dired.el Tue Apr 27 15:53:30 2004 +0000 @@ -1160,6 +1160,8 @@ :help "Edit file at cursor")) (define-key map [menu-bar immediate create-directory] '(menu-item "Create Directory..." dired-create-directory)) + (define-key map [menu-bar immediate wdired-mode] + '(menu-item "Edit File Names" wdired-change-to-wdired-mode)) (define-key map [menu-bar regexp] (cons "Regexp" (make-sparse-keymap "Regexp"))) @@ -1402,7 +1404,7 @@ (or switches dired-listing-switches)) (set (make-local-variable 'font-lock-defaults) '(dired-font-lock-keywords t nil nil beginning-of-line)) - (set (make-local-variable 'desktop-buffer-misc-data-function) + (set (make-local-variable 'desktop-save-buffer) 'dired-desktop-buffer-misc-data) (dired-sort-other dired-actual-switches t) (run-mode-hooks 'dired-mode-hook)
--- a/lisp/emacs-lisp/checkdoc.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/emacs-lisp/checkdoc.el Tue Apr 27 15:53:30 2004 +0000 @@ -2579,52 +2579,23 @@ ;;; Warning management ;; (defvar checkdoc-output-font-lock-keywords - '(("\\(\\w+\\.el\\): \\(\\w+\\)" + '(("^\\*\\*\\* \\(.+\\.el\\): \\([^ \n]+\\)" (1 font-lock-function-name-face) - (2 font-lock-comment-face)) - ("^\\(\\w+\\.el\\):" 1 font-lock-function-name-face) - (":\\([0-9]+\\):" 1 font-lock-constant-face)) + (2 font-lock-comment-face))) "Keywords used to highlight a checkdoc diagnostic buffer.") -(defvar checkdoc-output-mode-map nil - "Keymap used in `checkdoc-output-mode'.") +(defvar checkdoc-output-error-regex-alist + '(("^\\(.+\\.el\\):\\([0-9]+\\): " 1 2))) (defvar checkdoc-pending-errors nil "Non-nil when there are errors that have not been displayed yet.") -(if checkdoc-output-mode-map - nil - (setq checkdoc-output-mode-map (make-sparse-keymap)) - (if (not (string-match "XEmacs" emacs-version)) - (define-key checkdoc-output-mode-map [mouse-2] - 'checkdoc-find-error)) - (define-key checkdoc-output-mode-map "\C-c\C-c" 'checkdoc-find-error) - (define-key checkdoc-output-mode-map "\C-m" 'checkdoc-find-error)) - -(defun checkdoc-output-mode () - "Create and setup the buffer used to maintain checkdoc warnings. -\\<checkdoc-output-mode-map>\\[checkdoc-find-error] - Go to this error location." - (kill-all-local-variables) - (setq mode-name "Checkdoc" - major-mode 'checkdoc-output-mode) - (set (make-local-variable 'font-lock-defaults) - '((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w")))) - (use-local-map checkdoc-output-mode-map) - (run-mode-hooks 'checkdoc-output-mode-hook)) - -(defalias 'checkdoc-find-error-mouse 'checkdoc-find-error) -(defun checkdoc-find-error (&optional event) - "In a checkdoc diagnostic buffer, find the error under point." - (interactive (list last-input-event)) - (if event (posn-set-point (event-end e))) - (beginning-of-line) - (if (looking-at "\\(\\(\\w+\\|\\s_\\)+\\.el\\):\\([0-9]+\\):") - (let ((l (string-to-int (match-string 3))) - (f (match-string 1))) - (if (not (get-file-buffer f)) - (error "Can't find buffer %s" f)) - (switch-to-buffer-other-window (get-file-buffer f)) - (goto-line l)))) +(define-derived-mode checkdoc-output-mode compilation-mode "Checkdoc" + "Set up the major mode for the buffer containing the list of errors." + (set (make-local-variable 'compilation-error-regexp-alist) + checkdoc-output-error-regex-alist) + (set (make-local-variable 'compilation-mode-font-lock-keywords) + checkdoc-output-font-lock-keywords)) (defun checkdoc-buffer-label () "The name to use for a checkdoc buffer in the error list."
--- a/lisp/emacs-lisp/rx.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/emacs-lisp/rx.el Tue Apr 27 15:53:30 2004 +0000 @@ -1,6 +1,6 @@ ;;; rx.el --- sexp notation for regular expressions -;; Copyright (C) 2001, 2003, 2004 Free Software Foundation, Inc. +;; Copyright (C) 2001, 03, 2004 Free Software Foundation, Inc. ;; Author: Gerd Moellmann <gerd@gnu.org> ;; Maintainer: FSF @@ -32,6 +32,22 @@ ;; from the bugs mentioned in the commentary section of Sregex, and ;; uses a nicer syntax (IMHO, of course :-). +;; This significantly extended version of the original, is almost +;; compatible with Sregex. The only incompatibility I (fx) know of is +;; that the `repeat' form can't have multiple regexp args. + +;; Now alternative forms are provided for a degree of compatibility +;; with Shivers' attempted definitive SRE notation +;; <URL:http://www.ai.mit.edu/~/shivers/sre.txt>. SRE forms not +;; catered for include: dsm, uncase, w/case, w/nocase, ,@<exp>, +;; ,<exp>, (word ...), word+, posix-string, and character class forms. +;; Some forms are inconsistent with SRE, either for historical reasons +;; or because of the implementation -- simple translation into Emacs +;; regexp strings. These include: any, word. Also, case-sensitivity +;; and greediness are controlled by variables external to the regexp, +;; and you need to feed the forms to the `posix-' functions to get +;; SRE's POSIX semantics. There are probably more difficulties. + ;; Rx translates a sexp notation for regular expressions into the ;; usual string notation. The translation can be done at compile-time ;; by using the `rx' macro. It can be done at run-time by calling @@ -94,62 +110,103 @@ ;;; Code: - (defconst rx-constituents '((and . (rx-and 1 nil)) + (seq . and) ; SRE + (: . and) ; SRE + (sequence . and) ; sregex (or . (rx-or 1 nil)) + (| . or) ; SRE (not-newline . ".") + (nonl . not-newline) ; SRE (anything . ".\\|\n") - (any . (rx-any 1 1 rx-check-any)) + (any . (rx-any 1 nil rx-check-any)) ; inconsistent with SRE (in . any) + (char . any) ; sregex + (not-char . (rx-not-char 1 nil rx-check-any)) ; sregex (not . (rx-not 1 1 rx-check-not)) + ;; Partially consistent with sregex, whose `repeat' is like our + ;; `**'. (`repeat' with optional max arg and multiple sexp forms + ;; is ambiguous.) (repeat . (rx-repeat 2 3)) - (submatch . (rx-submatch 1 nil)) + (= . (rx-= 2 nil)) ; SRE + (>= . (rx->= 2 nil)) ; SRE + (** . (rx-** 2 nil)) ; SRE + (submatch . (rx-submatch 1 nil)) ; SRE (group . submatch) - (zero-or-more . (rx-kleene 1 1)) - (one-or-more . (rx-kleene 1 1)) - (zero-or-one . (rx-kleene 1 1)) - (\? . zero-or-one) + (zero-or-more . (rx-kleene 1 nil)) + (one-or-more . (rx-kleene 1 nil)) + (zero-or-one . (rx-kleene 1 nil)) + (\? . zero-or-one) ; SRE (\?? . zero-or-one) - (* . zero-or-more) + (* . zero-or-more) ; SRE (*? . zero-or-more) (0+ . zero-or-more) - (+ . one-or-more) + (+ . one-or-more) ; SRE (+? . one-or-more) (1+ . one-or-more) (optional . zero-or-one) + (opt . zero-or-one) ; sregex (minimal-match . (rx-greedy 1 1)) (maximal-match . (rx-greedy 1 1)) (backref . (rx-backref 1 1 rx-check-backref)) (line-start . "^") + (bol . line-start) ; SRE (line-end . "$") + (eol . line-end) ; SRE (string-start . "\\`") + (bos . string-start) ; SRE + (bot . string-start) ; sregex (string-end . "\\'") + (eos . string-end) ; SRE + (eot . string-end) ; sregex (buffer-start . "\\`") (buffer-end . "\\'") (point . "\\=") (word-start . "\\<") + (bow . word-start) ; SRE (word-end . "\\>") + (eow . word-end) ; SRE (word-boundary . "\\b") + (not-word-boundary . "\\B") ; sregex (syntax . (rx-syntax 1 1)) + (not-syntax . (rx-not-syntax 1 1)) ; sregex (category . (rx-category 1 1 rx-check-category)) (eval . (rx-eval 1 1)) (regexp . (rx-regexp 1 1 stringp)) (digit . "[[:digit:]]") - (control . "[[:cntrl:]]") - (hex-digit . "[[:xdigit:]]") - (blank . "[[:blank:]]") - (graphic . "[[:graph:]]") - (printing . "[[:print:]]") - (alphanumeric . "[[:alnum:]]") + (numeric . digit) ; SRE + (num . digit) ; SRE + (control . "[[:cntrl:]]") ; SRE + (cntrl . control) ; SRE + (hex-digit . "[[:xdigit:]]") ; SRE + (hex . hex-digit) ; SRE + (xdigit . hex-digit) ; SRE + (blank . "[[:blank:]]") ; SRE + (graphic . "[[:graph:]]") ; SRE + (graph . graphic) ; SRE + (printing . "[[:print:]]") ; SRE + (print . printing) ; SRE + (alphanumeric . "[[:alnum:]]") ; SRE + (alnum . alphanumeric) ; SRE (letter . "[[:alpha:]]") - (ascii . "[[:ascii:]]") + (alphabetic . letter) ; SRE + (alpha . letter) ; SRE + (ascii . "[[:ascii:]]") ; SRE (nonascii . "[[:nonascii:]]") - (lower . "[[:lower:]]") - (punctuation . "[[:punct:]]") - (space . "[[:space:]]") - (upper . "[[:upper:]]") - (word . "[[:word:]]")) + (lower . "[[:lower:]]") ; SRE + (lower-case . lower) ; SRE + (punctuation . "[[:punct:]]") ; SRE + (punct . punctuation) ; SRE + (space . "[[:space:]]") ; SRE + (whitespace . space) ; SRE + (white . space) ; SRE + (upper . "[[:upper:]]") ; SRE + (upper-case . upper) ; SRE + (word . "[[:word:]]") ; inconsistent with SRE + (wordchar . word) ; sregex + (not-wordchar . "[^[:word:]]") ; sregex (use \\W?) + ) "Alist of sexp form regexp constituents. Each element of the alist has the form (SYMBOL . DEFN). SYMBOL is a valid constituent of sexp regular expressions. @@ -252,6 +309,8 @@ (defun rx-check (form) "Check FORM according to its car's parsing info." + (unless (listp form) + (error "rx `%s' needs argument(s)" form)) (let* ((rx (rx-info (car form))) (nargs (1- (length form))) (min-args (nth 1 rx)) @@ -297,53 +356,61 @@ "\\)"))) -(defun rx-quote-for-set (string) - "Transform STRING for use in a character set. -If STRING contains a `]', move it to the front. -If STRING starts with a '^', move it to the end." - (when (string-match "\\`\\(\\(?:.\\|\n\\)+\\)\\]\\(\\(?:.\\|\n\\)\\)*\\'" - string) - (setq string (concat "]" (match-string 1 string) - (match-string 2 string)))) - (when (string-match "\\`^\\(\\(?:.\\|\n\\)+\\)\\'" string) - (setq string (concat (substring string 1) "^"))) - string) - +(defvar rx-bracket) ; dynamically bound in `rx-any' (defun rx-check-any (arg) "Check arg ARG for Rx `any'." - (cond ((integerp arg) t) - ((and (stringp arg) (zerop (length arg))) - (error "String arg for rx `any' must not be empty")) - ((stringp arg) t) - (t - (error "rx `any' requires string or character arg")))) - + (if (integerp arg) + (setq arg (string arg))) + (when (stringp arg) + (if (zerop (length arg)) + (error "String arg for Rx `any' must not be empty")) + ;; Quote ^ at start; don't bother to check whether this is first arg. + (if (eq ?^ (aref arg 0)) + (setq arg (concat "\\" arg))) + ;; Remove ] and set flag for adding it to start of overall result. + (when (string-match "]" arg) + (setq arg (replace-regexp-in-string "]" "" arg) + rx-bracket "]"))) + (when (symbolp arg) + (let ((translation (condition-case nil + (rx-to-string arg 'no-group) + (error nil)))) + (unless translation (error "Invalid char class `%s' in Rx `any'" arg)) + (setq arg (substring translation 1 -1)))) ; strip outer brackets + ;; sregex compatibility + (when (and (integerp (car-safe arg)) + (integerp (cdr-safe arg))) + (setq arg (string (car arg) ?- (cdr arg)))) + (unless (stringp arg) + (error "rx `any' requires string, character, char pair or char class args")) + arg) (defun rx-any (form) - "Parse and produce code from FORM, which is `(any STRING)'. -STRING is optional. If it is omitted, build a regexp that -matches anything." + "Parse and produce code from FORM, which is `(any ARG ...)'. +ARG is optional." (rx-check form) - (let ((arg (cadr form))) - (cond ((integerp arg) - (char-to-string arg)) - ((= (length arg) 1) - arg) - (t - (concat "[" (rx-quote-for-set (cadr form)) "]"))))) + (let* ((rx-bracket nil) + (args (mapcar #'rx-check-any (cdr form)))) ; side-effects `rx-bracket' + ;; If there was a ?- in the form, move it to the front to avoid + ;; accidental range. + (if (member "-" args) + (setq args (cons "-" (delete "-" args)))) + (apply #'concat "[" rx-bracket (append args '("]"))))) (defun rx-check-not (arg) "Check arg ARG for Rx `not'." - (unless (or (memq form - '(digit control hex-digit blank graphic printing - alphanumeric letter ascii nonascii lower - punctuation space upper word)) - (and (consp form) - (memq (car form) '(not any in syntax category:)))) - (error "rx `not' syntax error: %s" form)) - t) + (unless (or (and (symbolp arg) + (string-match "\\`\\[\\[:[-a-z]:]]\\'" + (condition-case nil + (rx-to-string arg 'no-group) + (error "")))) + (eq arg 'word-boundary) + (and (consp arg) + (memq (car arg) '(not any in syntax category)))) + (error "rx `not' syntax error: %s" arg)) + t) (defun rx-not (form) @@ -355,24 +422,67 @@ (if (= (length result) 4) (substring result 2 3) (concat "[" (substring result 2)))) - ((string-match "\\`\\[" result) + ((eq ?\[ (aref result 0)) (concat "[^" (substring result 1))) - ((string-match "\\`\\\\s." result) - (concat "\\S" (substring result 2))) - ((string-match "\\`\\\\S." result) - (concat "\\s" (substring result 2))) - ((string-match "\\`\\\\c." result) - (concat "\\C" (substring result 2))) - ((string-match "\\`\\\\C." result) - (concat "\\c" (substring result 2))) - ((string-match "\\`\\\\B" result) - (concat "\\b" (substring result 2))) - ((string-match "\\`\\\\b" result) - (concat "\\B" (substring result 2))) + ((string-match "\\`\\\\[scb]" result) + (concat (capitalize (substring result 0 2)) (substring result 2))) (t (concat "[^" result "]"))))) +(defun rx-not-char (form) + "Parse and produce code from FORM. FORM is `(not-char ...)'." + (rx-check form) + (rx-not `(not (in ,@(cdr form))))) + + +(defun rx-not-syntax (form) + "Parse and produce code from FORM. FORM is `(not-syntax SYNTAX)'." + (rx-check form) + (rx-not `(not (syntax ,@(cdr form))))) + + +(defun rx-trans-forms (form &optional skip) + "If FORM's length is greater than two, transform it to length two. +A form (HEAD REST ...) becomes (HEAD (and REST ...)). +If SKIP is non-nil, allow that number of items after the head, i.e. +`(= N REST ...)' becomes `(= N (and REST ...))' if SKIP is 1." + (unless skip (setq skip 0)) + (let ((tail (nthcdr (1+ skip) form))) + (if (= (length tail) 1) + form + (let ((form (copy-sequence form))) + (setcdr (nthcdr skip form) (list (cons 'and tail))) + form)))) + + +(defun rx-= (form) + "Parse and produce code from FORM `(= N ...)'." + (rx-check form) + (setq form (rx-trans-forms form 1)) + (unless (and (integerp (nth 1 form)) + (> (nth 1 form) 0)) + (error "rx `=' requires positive integer first arg")) + (format "%s\\{%d\\}" (rx-to-string (nth 2 form)) (nth 1 form))) + + +(defun rx->= (form) + "Parse and produce code from FORM `(>= N ...)'." + (rx-check form) + (setq form (rx-trans-forms form 1)) + (unless (and (integerp (nth 1 form)) + (> (nth 1 form) 0)) + (error "rx `>=' requires positive integer first arg")) + (format "%s\\{%d,\\}" (rx-to-string (nth 2 form)) (nth 1 form))) + + +(defun rx-** (form) + "Parse and produce code from FORM `(** N M ...)'." + (rx-check form) + (setq form (cons 'repeat (cdr (rx-trans-forms form 2)))) + (rx-to-string form)) + + (defun rx-repeat (form) "Parse and produce code from FORM. FORM is either `(repeat N FORM1)' or `(repeat N M FORM1)'." @@ -419,6 +529,7 @@ If OP is anything else, produce a greedy regexp if `rx-greedy-flag' is non-nil." (rx-check form) + (setq form (rx-trans-forms form)) (let ((suffix (cond ((memq (car form) '(* + ? )) "") ((memq (car form) '(*? +? ??)) "?") (rx-greedy-flag "") @@ -468,9 +579,15 @@ (defun rx-syntax (form) "Parse and produce code from FORM, which is `(syntax SYMBOL)'." (rx-check form) - (let ((syntax (assq (cadr form) rx-syntax))) + (let* ((sym (cadr form)) + (syntax (assq sym rx-syntax))) (unless syntax - (error "Unknown rx syntax `%s'" (cadr form))) + ;; Try sregex compatibility. + (let ((name (symbol-name sym))) + (if (= 1 (length name)) + (setq syntax (rassq (aref name 0) rx-syntax)))) + (unless syntax + (error "Unknown rx syntax `%s'" (cadr form)))) (format "\\s%c" (cdr syntax)))) @@ -483,7 +600,7 @@ (defun rx-category (form) - "Parse and produce code from FORM, which is `(category SYMBOL ...)'." + "Parse and produce code from FORM, which is `(category SYMBOL)'." (rx-check form) (let ((char (if (integerp (cadr form)) (cadr form) @@ -543,8 +660,9 @@ ;;;###autoload -(defmacro rx (regexp) - "Translate a regular expression REGEXP in sexp form to a regexp string. +(defmacro rx (&rest regexps) + "Translate regular expressions REGEXPS in sexp form to a regexp string. +REGEXPS is a non-empty sequence of forms of the sort listed below. See also `rx-to-string' for how to do such a translation at run-time. The following are valid subforms of regular expressions in sexp @@ -556,53 +674,58 @@ CHAR matches character CHAR literally. -`not-newline' +`not-newline', `nonl' matches any character except a newline. . `anything' matches any character -`(any SET)' - matches any character in SET. SET may be a character or string. +`(any SET ...)' +`(in SET ...)' +`(char SET ...)' + matches any character in SET .... SET may be a character or string. Ranges of characters can be specified as `A-Z' in strings. + Ranges may also be specified as conses like `(?A . ?Z)'. -'(in SET)' - like `any'. + SET may also be the name of a character class: `digit', + `control', `hex-digit', `blank', `graph', `print', `alnum', + `alpha', `ascii', `nonascii', `lower', `punct', `space', `upper', + `word', or one of their synonyms. -`(not (any SET))' - matches any character not in SET +`(not (any SET ...))' + matches any character not in SET ... -`line-start' +`line-start', `bol' matches the empty string, but only at the beginning of a line in the text being matched -`line-end' +`line-end', `eol' is similar to `line-start' but matches only at the end of a line -`string-start' +`string-start', `bos', `bot' matches the empty string, but only at the beginning of the string being matched against. -`string-end' +`string-end', `eos', `eot' matches the empty string, but only at the end of the string being matched against. `buffer-start' matches the empty string, but only at the beginning of the - buffer being matched against. + buffer being matched against. Actually equivalent to `string-start'. `buffer-end' matches the empty string, but only at the end of the - buffer being matched against. + buffer being matched against. Actually equivalent to `string-end'. `point' matches the empty string, but only at point. -`word-start' +`word-start', `bow' matches the empty string, but only at the beginning or end of a word. -`word-end' +`word-end', `eow' matches the empty string, but only at the end of a word. `word-boundary' @@ -610,34 +733,35 @@ word. `(not word-boundary)' +`not-word-boundary' matches the empty string, but not at the beginning or end of a word. -`digit' +`digit', `numeric', `num' matches 0 through 9. -`control' +`control', `cntrl' matches ASCII control characters. -`hex-digit' +`hex-digit', `hex', `xdigit' matches 0 through 9, a through f and A through F. `blank' matches space and tab only. -`graphic' +`graphic', `graph' matches graphic characters--everything except ASCII control chars, space, and DEL. -`printing' +`printing', `print' matches printing characters--everything except ASCII control chars and DEL. -`alphanumeric' +`alphanumeric', `alnum' matches letters and digits. (But at present, for multibyte characters, it matches anything that has word syntax.) -`letter' +`letter', `alphabetic', `alpha' matches letters. (But at present, for multibyte characters, it matches anything that has word syntax.) @@ -647,25 +771,29 @@ `nonascii' matches non-ASCII (multibyte) characters. -`lower' +`lower', `lower-case' matches anything lower-case. -`upper' +`upper', `upper-case' matches anything upper-case. -`punctuation' +`punctuation', `punct' matches punctuation. (But at present, for multibyte characters, it matches anything that has non-word syntax.) -`space' +`space', `whitespace', `white' matches anything that has whitespace syntax. -`word' +`word', `wordchar' matches anything that has word syntax. +`not-wordchar' + matches anything that has non-word syntax. + `(syntax SYNTAX)' matches a character with syntax SYNTAX. SYNTAX must be one - of the following symbols. + of the following symbols, or a symbol corresponding to the syntax + character, e.g. `\\.' for `\\s.'. `whitespace' (\\s- in string notation) `punctuation' (\\s.) @@ -684,7 +812,7 @@ `comment-delimiter' (\\s!) `(not (syntax SYNTAX))' - matches a character that has not syntax SYNTAX. + matches a character that doesn't have syntax SYNTAX. `(category CATEGORY)' matches a character with category CATEGORY. CATEGORY must be @@ -710,7 +838,7 @@ `japanese-katakana-two-byte' (\\cK) `korean-hangul-two-byte' (\\cN) `cyrillic-two-byte' (\\cY) - `combining-diacritic' (\\c^) + `combining-diacritic' (\\c^) `ascii' (\\ca) `arabic' (\\cb) `chinese' (\\cc) @@ -731,12 +859,16 @@ `can-break' (\\c|) `(not (category CATEGORY))' - matches a character that has not category CATEGORY. + matches a character that doesn't have category CATEGORY. `(and SEXP1 SEXP2 ...)' +`(: SEXP1 SEXP2 ...)' +`(seq SEXP1 SEXP2 ...)' +`(sequence SEXP1 SEXP2 ...)' matches what SEXP1 matches, followed by what SEXP2 matches, etc. `(submatch SEXP1 SEXP2 ...)' +`(group SEXP1 SEXP2 ...)' like `and', but makes the match accessible with `match-end', `match-beginning', and `match-string'. @@ -744,6 +876,7 @@ another name for `submatch'. `(or SEXP1 SEXP2 ...)' +`(| SEXP1 SEXP2 ...)' matches anything that matches SEXP1 or SEXP2, etc. If all args are strings, use `regexp-opt' to optimize the resulting regular expression. @@ -757,47 +890,55 @@ `(maximal-match SEXP)' produce a greedy regexp for SEXP. This is the default. -`(zero-or-more SEXP)' - matches zero or more occurrences of what SEXP matches. +Below, `SEXP ...' represents a sequence of regexp forms, treated as if +enclosed in `(and ...)'. -`(0+ SEXP)' - like `zero-or-more'. - -`(* SEXP)' - like `zero-or-more', but always produces a greedy regexp. +`(zero-or-more SEXP ...)' +`(0+ SEXP ...)' + matches zero or more occurrences of what SEXP ... matches. -`(*? SEXP)' - like `zero-or-more', but always produces a non-greedy regexp. +`(* SEXP ...)' + like `zero-or-more', but always produces a greedy regexp, independent + of `rx-greedy-flag'. -`(one-or-more SEXP)' - matches one or more occurrences of A. +`(*? SEXP ...)' + like `zero-or-more', but always produces a non-greedy regexp, + independent of `rx-greedy-flag'. -`(1+ SEXP)' - like `one-or-more'. +`(one-or-more SEXP ...)' +`(1+ SEXP ...)' + matches one or more occurrences of SEXP ... -`(+ SEXP)' +`(+ SEXP ...)' like `one-or-more', but always produces a greedy regexp. -`(+? SEXP)' +`(+? SEXP ...)' like `one-or-more', but always produces a non-greedy regexp. -`(zero-or-one SEXP)' +`(zero-or-one SEXP ...)' +`(optional SEXP ...)' +`(opt SEXP ...)' matches zero or one occurrences of A. -`(optional SEXP)' - like `zero-or-one'. - -`(? SEXP)' +`(? SEXP ...)' like `zero-or-one', but always produces a greedy regexp. -`(?? SEXP)' +`(?? SEXP ...)' like `zero-or-one', but always produces a non-greedy regexp. `(repeat N SEXP)' - matches N occurrences of what SEXP matches. +`(= N SEXP ...)' + matches N occurrences. + +`(>= N SEXP ...)' + matches N or more occurrences. `(repeat N M SEXP)' - matches N to M occurrences of what SEXP matches. +`(** N M SEXP ...)' + matches N to M occurrences. + +`(backref N)' + matches what was matched previously by submatch N. `(backref N)' matches what was matched previously by submatch N. @@ -811,9 +952,21 @@ `(regexp REGEXP)' include REGEXP in string notation in the result." + (cond ((null regexps) + (error "No regexp")) + ((cdr regexps) + (rx-to-string `(and ,@regexps) t)) + (t + (rx-to-string (car regexps) t)))) + +;; ;; sregex.el replacement - (rx-to-string regexp)) - +;; ;;;###autoload (provide 'sregex) +;; ;;;###autoload (autoload 'sregex "rx") +;; (defalias 'sregex 'rx-to-string) +;; ;;;###autoload (autoload 'sregexq "rx" nil nil 'macro) +;; (defalias 'sregexq 'rx) + (provide 'rx) ;;; arch-tag: 12d01a63-0008-42bb-ab8c-1c7d63be370b
--- a/lisp/help.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/help.el Tue Apr 27 15:53:30 2004 +0000 @@ -1,6 +1,6 @@ ;;; help.el --- help commands for Emacs -;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2004 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -313,19 +313,61 @@ (defun view-emacs-news (&optional arg) "Display info on recent changes to Emacs. -With numeric argument, display information on correspondingly older changes." +With argument, display info only for the selected version." (interactive "P") - (let* ((arg (if arg (prefix-numeric-value arg) 0)) - (file (cond ((eq arg 0) "NEWS") - ((eq arg 1) "ONEWS") - (t - (nth (- arg 2) - (nreverse (directory-files data-directory - nil "^ONEWS\\.[0-9]+$" - nil))))))) - (if file - (view-file (expand-file-name file data-directory)) - (error "No such old news")))) + (if (not arg) + (view-file (expand-file-name "NEWS" data-directory)) + (let* ((map (sort + (delete-dups + (apply + 'nconc + (mapcar + (lambda (file) + (with-temp-buffer + (insert-file-contents + (expand-file-name file data-directory)) + (let (res) + (while (re-search-forward + (if (string-match "^ONEWS\\.[0-9]+$" file) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" + "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t) + (setq res (cons (list (match-string-no-properties 1) + file) res))) + res))) + (append '("NEWS" "ONEWS") + (directory-files data-directory nil + "^ONEWS\\.[0-9]+$" nil))))) + (lambda (a b) + (string< (car b) (car a))))) + (current (caar map)) + (version (completing-read + (format "Read NEWS for the version (default %s): " current) + (mapcar 'car map) nil nil nil nil current)) + (file (cadr (assoc version map))) + res) + (if (not file) + (error "No news is good news") + (view-file (expand-file-name file data-directory)) + (widen) + (goto-char (point-min)) + (when (re-search-forward + (concat (if (string-match "^ONEWS\\.[0-9]+$" file) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*" + "^\* [^0-9\n]*") version) + nil t) + (beginning-of-line) + (narrow-to-region + (point) + (save-excursion + (while (and (setq res + (re-search-forward + (if (string-match "^ONEWS\\.[0-9]+$" file) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" + "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)) + (equal (match-string-no-properties 1) version))) + (or res (goto-char (point-max))) + (beginning-of-line) + (point)))))))) (defun view-todo (&optional arg) "Display the Emacs TODO list."
--- a/lisp/ielm.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/ielm.el Tue Apr 27 15:53:30 2004 +0000 @@ -1,6 +1,6 @@ ;;; ielm.el --- interaction mode for Emacs Lisp -;; Copyright (C) 1994, 2002, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1994, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: David Smith <maa036@lancaster.ac.uk> ;; Maintainer: FSF @@ -49,12 +49,45 @@ :type 'boolean :group 'ielm) +(defcustom ielm-prompt-read-only t + "If non-nil, the IELM prompt is read only. +Setting this variable does not affect existing IELM runs. + +You can give the IELM prompt more highly customized read-only +type properties, by setting this option to nil, and then setting +`ielm-prompt', outside of Custom, to a string with the desired +text properties. + +Interrupting the IELM process with \\<ielm-map>\\[comint-interrupt-subjob], +and then restarting it using \\[ielm], makes the then current +default value affect _new_ prompts. However, executing \\[ielm] +does not have this effect on *ielm* buffers with a running process. +For IELM buffers that are not called `*ielm*', you can execute +\\[inferior-emacs-lisp-mode] in that IELM buffer to update the value, +for new prompts. This works even if the buffer has a running process." + :type 'boolean + :group 'ielm + :version "21.4") + (defcustom ielm-prompt "ELISP> " - "Prompt used in IELM." + "Prompt used in IELM. +Setting the default value does not affect existing IELM runs. +`inferior-emacs-lisp-mode' converts this into a buffer-local +variable in IELM buffers. The buffer-local value is meant for +internal use by IELM. Do not try to set the buffer-local value +yourself in any way, unless you really know what you are doing. + +Interrupting the IELM process with \\<ielm-map>\\[comint-interrupt-subjob], +and then restarting it using \\[ielm], makes the then current +_default_ value affect _new_ prompts. Unless the new prompt +differs only in text properties from the old one, IELM will no +longer recognize the old prompts. However, executing \\[ielm] +does not update the prompt of an *ielm* buffer with a running process. +For IELM buffers that are not called `*ielm*', you can execute +\\[inferior-emacs-lisp-mode] in that IELM buffer to update the value, +for new prompts. This works even if the buffer has a running process." :type 'string - :group 'ielm - :get #'(lambda (symbol) (substring-no-properties (symbol-value symbol))) - :set #'(lambda (symbol value) (set symbol (propertize value 'read-only t 'rear-nonsticky t)))) + :group 'ielm) (defcustom ielm-dynamic-return t "*Controls whether \\<ielm-map>\\[ielm-return] has intelligent behaviour in IELM. @@ -414,8 +447,8 @@ `set-buffer', or with \\[ielm-change-working-buffer]), and its value is preserved between successive evaluations. In this way, expressions may be evaluated in a different buffer than the *ielm* buffer. -Display the name of the working buffer with \\[ielm-print-working-buffer], -or the buffer itself with \\[ielm-display-working-buffer]. +By default, its name is shown on the mode line; you can always display +it with \\[ielm-print-working-buffer], or the buffer itself with \\[ielm-display-working-buffer]. During evaluations, the values of the variables `*', `**', and `***' are the results of the previous, second previous and third previous @@ -426,14 +459,16 @@ Expressions evaluated by IELM are not subject to `debug-on-quit' or `debug-on-error'. -The behaviour of IELM may be customised with the following variables: -* To stop beeping on error, set `ielm-noisy' to nil +The behaviour of IELM may be customized with the following variables: +* To stop beeping on error, set `ielm-noisy' to nil. * If you don't like the prompt, you can change it by setting `ielm-prompt'. -* Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode' +* If you do not like that the prompt is (by default) read-only, set + `ielm-prompt-read-only' to nil. +* Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode'. * Entry to this mode runs `comint-mode-hook' and `ielm-mode-hook' (in that order). -Customised bindings may be defined in `ielm-map', which currently contains: +Customized bindings may be defined in `ielm-map', which currently contains: \\{ielm-map}" (interactive) (comint-mode) @@ -443,6 +478,13 @@ (setq comint-input-sender 'ielm-input-sender) (setq comint-process-echoes nil) (make-local-variable 'comint-dynamic-complete-functions) + (set (make-local-variable 'ielm-prompt) + (if ielm-prompt-read-only + (propertize ielm-prompt + 'read-only t + 'rear-nonsticky t + 'front-sticky '(read-only)) + ielm-prompt)) (setq comint-dynamic-complete-functions '(ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol)) (setq comint-get-old-input 'ielm-get-old-input) @@ -452,6 +494,7 @@ (setq major-mode 'inferior-emacs-lisp-mode) (setq mode-name "IELM") + (setq mode-line-process '(":%s on " (:eval (buffer-name ielm-working-buffer)))) (use-local-map ielm-map) (set-syntax-table emacs-lisp-mode-syntax-table) @@ -494,9 +537,10 @@ (insert ielm-header) (ielm-set-pm (point-max)) (unless comint-use-prompt-regexp-instead-of-fields - (add-text-properties - (point-min) (point-max) - '(rear-nonsticky t field output inhibit-line-move-field-capture t))) + (let ((inhibit-read-only t)) + (add-text-properties + (point-min) (point-max) + '(rear-nonsticky t field output inhibit-line-move-field-capture t)))) (comint-output-filter (ielm-process) ielm-prompt) (set-marker comint-last-input-start (ielm-pm)) (set-process-filter (get-buffer-process (current-buffer)) 'comint-output-filter)) @@ -521,12 +565,13 @@ "Interactively evaluate Emacs Lisp expressions. Switches to the buffer `*ielm*', or creates it if it does not exist." (interactive) - (if (comint-check-proc "*ielm*") - nil - (save-excursion - (set-buffer (get-buffer-create "*ielm*")) - (inferior-emacs-lisp-mode))) - (pop-to-buffer "*ielm*")) + (let (old-point) + (unless (comint-check-proc "*ielm*") + (with-current-buffer (get-buffer-create "*ielm*") + (unless (eq (buffer-size) 0) (setq old-point (point))) + (inferior-emacs-lisp-mode))) + (pop-to-buffer "*ielm*") + (when old-point (push-mark old-point)))) (provide 'ielm)
--- a/lisp/image.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/image.el Tue Apr 27 15:53:30 2004 +0000 @@ -241,7 +241,7 @@ (setq x (+ x dx)))) (setq x 0.0 y (+ y dy)) - (insert "\n")))) + (insert (propertize "\n" 'line-height 0)))))
--- a/lisp/info-look.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/info-look.el Tue Apr 27 15:53:30 2004 +0000 @@ -1,7 +1,7 @@ ;;; info-look.el --- major-mode-sensitive Info index lookup facility ;; An older version of this was known as libc.el. -;; Copyright (C) 1995,96,97,98,99,2001,2003,2004 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98,99,2001,03,04 Free Software Foundation, Inc. ;; Author: Ralph Schleicher <rs@nunatak.allgaeu.org> ;; (did not show signs of life (Nov 2001) -stef) @@ -408,12 +408,11 @@ (message "No %s help available for `%s'" topic mode) ;; Recursively setup cross references. ;; But refer only to non-void modes. - (mapcar (lambda (arg) - (or (info-lookup->initialized topic arg) - (info-lookup-setup-mode topic arg)) - (and (eq (info-lookup->initialized topic arg) t) - (setq refer-modes (cons arg refer-modes)))) - (info-lookup->other-modes topic mode)) + (dolist (arg (info-lookup->other-modes topic mode)) + (or (info-lookup->initialized topic arg) + (info-lookup-setup-mode topic arg)) + (and (eq (info-lookup->initialized topic arg) t) + (setq refer-modes (cons arg refer-modes)))) (setq refer-modes (nreverse refer-modes)) ;; Build the full completion alist. (setq completions @@ -887,6 +886,12 @@ "awk") ((string-equal item "gawk, versions of, information about, printing") "gawk")))))) + +(info-lookup-maybe-add-help + :mode 'cfengine-mode + :regexp "[[:alnum:]_]+" + :doc-spec '(("(cfengine-Reference)Variable Index" nil + "^ - [^:]+:[ ]+\\(\\[[^=]*=[ ]+\\)?" nil))) (provide 'info-look)
--- a/lisp/info.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/info.el Tue Apr 27 15:53:30 2004 +0000 @@ -88,7 +88,7 @@ (defface info-xref-visited '((t :inherit info-xref) (((class color) (background light)) :foreground "magenta4") - (((class color) (background dark)) :foreground "magenta4")) + (((class color) (background dark)) :foreground "magenta3")) ;"violet"? "Face for visited Info cross-references." :group 'info) @@ -239,10 +239,11 @@ (defvar Info-index-alternatives nil "List of possible matches for last `Info-index' command.") -(defvar Info-reference-name nil - "Name of the selected cross-reference. -Point is moved to the proper occurrence of this name within a node -after selecting it.") +(defvar Info-point-loc nil + "Point location within a selected node. +If string, the point is moved to the proper occurrence of the +name of the followed cross reference within a selected node. +If number, the point is moved to the corresponding line.") (defvar Info-standalone nil "Non-nil if Emacs was started solely as an Info browser.") @@ -449,28 +450,38 @@ "Like `info' but show the Info buffer in another window." (interactive (if current-prefix-arg (list (read-file-name "Info file name: " nil nil t)))) - (let (same-window-buffer-names) + (let (same-window-buffer-names same-window-regexps) (info file))) -;;;###autoload (add-hook 'same-window-buffer-names "*info*") +;;;###autoload (add-hook 'same-window-regexps "\\*info\\*\\(\\|<[0-9]+>\\)") ;;;###autoload -(defun info (&optional file) +(defun info (&optional file buffer) "Enter Info, the documentation browser. Optional argument FILE specifies the file to examine; the default is the top-level directory of Info. Called from a program, FILE may specify an Info node of the form `(FILENAME)NODENAME'. +Optional argument BUFFER specifies the Info buffer name; +the default buffer name is *info*. If BUFFER exists, +just switch to BUFFER. Otherwise, create a new buffer +with the top-level Info directory. -In interactive use, a prefix argument directs this command -to read a file name from the minibuffer. +In interactive use, a non-numeric prefix argument directs +this command to read a file name from the minibuffer. +A numeric prefix argument appends the number to the buffer name. The search path for Info files is in the variable `Info-directory-list'. The top-level Info directory is made by combining all the files named `dir' in all the directories in that path." - (interactive (if current-prefix-arg - (list (read-file-name "Info file name: " nil nil t)))) - (pop-to-buffer "*info*") + (interactive (list + (if (and current-prefix-arg (not (numberp current-prefix-arg))) + (read-file-name "Info file name: " nil nil t)) + (if (numberp current-prefix-arg) + (format "*info*<%s>" current-prefix-arg)))) + (pop-to-buffer (or buffer "*info*")) + (if (and buffer (not (eq major-mode 'Info-mode))) + (Info-mode)) (if file ;; If argument already contains parentheses, don't add another set ;; since the argument will then be parsed improperly. This also @@ -866,9 +877,12 @@ (cons new-history (delete new-history Info-history-list)))) (goto-char anchorpos)) - (Info-reference-name - (Info-find-index-name Info-reference-name) - (setq Info-reference-name nil)))))) + ((numberp Info-point-loc) + (forward-line (1- Info-point-loc)) + (setq Info-point-loc nil)) + ((stringp Info-point-loc) + (Info-find-index-name Info-point-loc) + (setq Info-point-loc nil)))))) ;; If we did not finish finding the specified node, ;; go back to the previous one. (or Info-current-node no-going-back (null Info-history) @@ -1313,9 +1327,9 @@ "" (match-string 2 nodename)) nodename (match-string 3 nodename)) - (let ((trim (string-match "\\s *\\'" filename))) + (let ((trim (string-match "\\s +\\'" filename))) (if trim (setq filename (substring filename 0 trim)))) - (let ((trim (string-match "\\s *\\'" nodename))) + (let ((trim (string-match "\\s +\\'" nodename))) (if trim (setq nodename (substring nodename 0 trim)))) (if transient-mark-mode (deactivate-mark)) (Info-find-node (if (equal filename "") nil filename) @@ -1664,10 +1678,11 @@ (insert "*Note Top::\n") (Info-insert-toc (nth 2 (assoc "Top" node-list)) ; get Top nodes - node-list 0 (file-name-nondirectory curr-file))) + node-list 0 curr-file)) (if (not (bobp)) (let ((Info-hide-note-references 'hide) (Info-fontify-visited-nodes nil)) + (setq Info-current-node "Top") (Info-fontify-node))) (goto-char (point-min)) (if (setq p (search-forward (concat "*Note " curr-node ":") nil t)) @@ -1829,8 +1844,7 @@ (if (and (save-excursion (goto-char (+ (point) 5)) ; skip a possible *note (re-search-backward "\\*note[ \n\t]+" nil t) - (looking-at (concat "\\*note[ \n\t]+" - (Info-following-node-name-re "^.,\t")))) + (looking-at str)) (<= (point) (match-end 0))) (goto-char (match-beginning 0)))) ;; Go to the reference closest to point @@ -1858,11 +1872,27 @@ Because of ambiguities, this should be concatenated with something like `:' and `Info-following-node-name-re'.") -(defun Info-extract-menu-node-name (&optional multi-line) +(defun Info-extract-menu-node-name (&optional multi-line index-node) (skip-chars-forward " \t\n") (when (looking-at (concat Info-menu-entry-name-re ":\\(:\\|" (Info-following-node-name-re - (if multi-line "^.,\t" "^.,\t\n")) "\\)")) + (cond + (index-node "^,\t\n") + (multi-line "^.,\t") + (t "^.,\t\n"))) + "\\)" + (if index-node + "\\.\\(?:[ \t\n]+(line +\\([0-9]+\\))\\)?" + ""))) + (if index-node + (setq Info-point-loc + (if (match-beginning 5) + (string-to-number (match-string 5)) + (buffer-substring (match-beginning 0) (1- (match-beginning 1))))) +;;; Comment out the next line to use names of cross-references: +;;; (setq Info-point-loc +;;; (buffer-substring (match-beginning 0) (1- (match-beginning 1)))) + ) (replace-regexp-in-string "[ \n]+" " " (or (match-string 2) @@ -2327,7 +2357,7 @@ (if (equal Info-current-file "dir") (error "The Info directory node has no index; use m to select a manual")) (let ((orignode Info-current-node) - (pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^.\n]*\\)\\.[ \t]*\\([0-9]*\\)" + (pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" (regexp-quote topic))) node (case-fold-search t)) @@ -2379,7 +2409,7 @@ num (1- num))) (Info-goto-node (nth 1 (car Info-index-alternatives))) (if (> (nth 3 (car Info-index-alternatives)) 0) - (forward-line (nth 3 (car Info-index-alternatives))) + (forward-line (1- (nth 3 (car Info-index-alternatives)))) (forward-line 3) ; don't search in headers (let ((name (car (car Info-index-alternatives)))) (Info-find-index-name name))) @@ -2418,7 +2448,7 @@ Build a menu of the possible matches." (interactive "sIndex apropos: ") (unless (string= string "") - (let ((pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^.]+\\)." + (let ((pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" (regexp-quote string))) (ohist Info-history) (ohist-list Info-history-list) @@ -2447,9 +2477,10 @@ (goto-char (point-min)) (while (re-search-forward pattern nil t) (add-to-list 'matches - (list (match-string 1) - (match-string 2) - manual))) + (list manual + (match-string-no-properties 1) + (match-string-no-properties 2) + (match-string-no-properties 3)))) (and (setq node (Info-extract-pointer "next" t)) (string-match "\\<Index\\>" node))) (Info-goto-node node)))) @@ -2465,9 +2496,12 @@ (insert "\n \nFile: apropos, Node: Top, Up: (dir)\n") (insert "* Menu: \nNodes whose indices contain \"" string "\"\n\n") (dolist (entry matches) - (insert "* " (car entry) " [" (nth 2 entry) - "]: (" (nth 2 entry) ")" (nth 1 entry) ".\n"))) - (Info-find-node "apropos" "top"))))) + (insert "* " (nth 1 entry) " [" (nth 0 entry) + "]: (" (nth 0 entry) ")" (nth 2 entry) "." + (if (nth 3 entry) (concat " (line " (nth 3 entry) ")") "") + "\n"))) + (Info-find-node "apropos" "top") + (setq Info-complete-cache nil))))) (defun Info-undefined () "Make command be undefined in Info." @@ -2583,21 +2617,16 @@ (browse-url (browse-url-url-at-point))) ((setq node (Info-get-token (point) "\\*note[ \n\t]+" "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?")) -;;; (or (match-string 2) -;;; (setq Info-reference-name -;;; (replace-regexp-in-string -;;; "[ \n\t]+" " " (match-string-no-properties 1)))) (Info-follow-reference node fork)) ;; menu item: node name ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::")) (Info-goto-node node fork)) - ;; menu item: index entry + ;; menu item: node name or index entry ((Info-get-token (point) "\\* +" "\\* +\\(.*\\): ") - (if (save-match-data (string-match "\\<index\\>" Info-current-node)) - (setq Info-reference-name (match-string-no-properties 1))) (beginning-of-line) (forward-char 2) - (setq node (Info-extract-menu-node-name)) + (setq node (Info-extract-menu-node-name + nil (string-match "\\<index\\>" Info-current-node))) (Info-goto-node node fork)) ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)")) (Info-goto-node node fork)) @@ -2847,6 +2876,7 @@ \\[Info-toc] Go to the buffer with a table of contents. \\[Info-index] Look up a topic in this file's Index and move to that node. \\[Info-index-next] (comma) Move to the next match from a previous \\<Info-mode-map>\\[Info-index] command. +\\[info-apropos] Look for a string in the indices of all manuals. \\[Info-top-node] Go to the Top node of this file. \\[Info-final-node] Go to the final node in this file. \\[Info-backward-node] Go backward one node, considering all nodes as forming one sequence. @@ -2907,8 +2937,8 @@ ;; This is for the sake of the invisible text we use handling titles. (make-local-variable 'line-move-ignore-invisible) (setq line-move-ignore-invisible t) - (make-local-variable 'desktop-buffer-misc-data-function) - (setq desktop-buffer-misc-data-function 'Info-desktop-buffer-misc-data) + (make-local-variable 'desktop-save-buffer) + (setq desktop-save-buffer 'Info-desktop-buffer-misc-data) (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) (Info-set-mode-line) @@ -3351,7 +3381,8 @@ (hl Info-history-list) res) (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) - (setq file (match-string 1 node) + (setq file (file-name-nondirectory + (match-string 1 node)) node (if (equal (match-string 2 node) "") "Top" (match-string 2 node)))) @@ -3451,7 +3482,8 @@ (hl Info-history-list) res) (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) - (setq file (match-string 1 node) + (setq file (file-name-nondirectory + (match-string 1 node)) node (if (equal (match-string 2 node) "") "Top" (match-string 2 node)))) @@ -3499,6 +3531,13 @@ (put-text-property (match-beginning 1) (match-end 1) 'font-lock-face 'info-menu-header))) + ;; Hide index line numbers + (goto-char (point-min)) + (when (and not-fontified-p (string-match "\\<Index\\>" Info-current-node)) + (while (re-search-forward "[ \t\n]*(line +[0-9]+)" nil t) + (put-text-property (match-beginning 0) (match-end 0) + 'invisible t))) + ;; Fontify http and ftp references (goto-char (point-min)) (when not-fontified-p
--- a/lisp/log-view.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/log-view.el Tue Apr 27 15:53:30 2004 +0000 @@ -191,8 +191,10 @@ "Get the diff for several revisions. If the point is the same as the mark, get the diff for this revision. Otherwise, get the diff between the revisions - were the region starts and ends." - (interactive "r") +were the region starts and ends." + (interactive + (list (if mark-active (region-beginning) (point)) + (if mark-active (region-end) (point)))) (let ((fr (log-view-current-tag beg)) (to (log-view-current-tag end))) (when (string-equal fr to)
--- a/lisp/mail/rmail.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/mail/rmail.el Tue Apr 27 15:53:30 2004 +0000 @@ -227,7 +227,9 @@ ;;;###autoload (defcustom rmail-mail-new-frame nil - "*Non-nil means Rmail makes a new frame for composing outgoing mail." + "*Non-nil means Rmail makes a new frame for composing outgoing mail. +This is handy if you want to preserve the window configuration of +the frame where you have the RMAIL buffer displayed." :type 'boolean :group 'rmail-reply) @@ -1137,7 +1139,9 @@ (make-local-variable 'kill-buffer-hook) (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary) (make-local-variable 'file-precious-flag) - (setq file-precious-flag t)) + (setq file-precious-flag t) + (make-local-variable 'desktop-save-buffer) + (setq desktop-save-buffer t)) ;; Handle M-x revert-buffer done in an rmail-mode buffer. (defun rmail-revert (arg noconfirm) @@ -1666,7 +1670,15 @@ (defun rmail-decode-region (from to coding) (if (or (not coding) (not (coding-system-p coding))) (setq coding 'undecided)) - (decode-coding-region from to coding)) + ;; Use -dos decoding, to remove ^M characters left from base64 or + ;; rogue qp-encoded text. + (decode-coding-region from to + (coding-system-change-eol-conversion coding 1)) + ;; Don't reveal the fact we used -dos decoding, as users generally + ;; will not expect the RMAIL buffer to use DOS EOL format. + (setq buffer-file-coding-system + (setq last-coding-system-used + (coding-system-change-eol-conversion coding 0)))) ;; the rmail-break-forwarded-messages feature is not implemented (defun rmail-convert-to-babyl-format () @@ -1751,9 +1763,6 @@ (error nil)) ;; Change "base64" to "8bit", to reflect the ;; decoding we just did. - (goto-char (1+ header-end)) - (while (search-forward "\r\n" (point-max) t) - (replace-match "\n")) (goto-char base64-header-field-end) (delete-region (point) (search-backward ":")) (insert ": 8bit")))) @@ -1901,9 +1910,6 @@ (point))) t) (error nil)) - (goto-char header-end) - (while (search-forward "\r\n" (point-max) t) - (replace-match "\n")) ;; Change "base64" to "8bit", to reflect the ;; decoding we just did. (goto-char base64-header-field-end) @@ -3167,7 +3173,7 @@ (compose-mail to subject others noerase nil yank-action sendactions) - (if (and (display-multi-frame-p) rmail-mail-new-frame) + (if rmail-mail-new-frame (prog1 (compose-mail to subject others noerase 'switch-to-buffer-other-frame
--- a/lisp/mail/sendmail.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/mail/sendmail.el Tue Apr 27 15:53:30 2004 +0000 @@ -714,7 +714,12 @@ (if (and (or (window-dedicated-p (frame-selected-window)) (cdr (assq 'mail-dedicated-frame (frame-parameters)))) (not (null (delq (selected-frame) (visible-frame-list))))) - (delete-frame (selected-frame)) + (progn + (if (display-multi-frame-p) + (delete-frame (selected-frame)) + ;; The previous frame is where normally they have the + ;; RMAIL buffer displayed. + (other-frame -1))) (let (rmail-flag summary-buffer) (and (not arg) (not (one-window-p))
--- a/lisp/mh-e/ChangeLog Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/mh-e/ChangeLog Tue Apr 27 15:53:30 2004 +0000 @@ -1,3 +1,6 @@ +2004-04-26 Lars Hansen <larsh@math.ku.dk> + * mh-e.el (mh-folder-mode): Bind desktop-save-buffer to t. + 2003-04-24 Bill Wohler <wohler@newt.com> * Released MH-E version 7.3. @@ -47,6 +50,10 @@ runs checkdoc and lm-verify which is useful before releasing the software. It can and should be expanded to do real unit tests. +2004-04-22 Lars Hansen <larsh@math.ku.dk> + + * mh-e.el (mh-restore-desktop-buffer): Delete with-no-warnings. + 2003-04-22 Mark D Baushke <mdb@gnu.org> * mh-alias.el: Update Copyright. @@ -71,6 +78,11 @@ Emacs. (mh-exec-cmd-error): Add a comment, so that we change it later on. +2004-04-21 Lars Hansen <larsh@math.ku.dk> + + * mh-e.el (mh-restore-desktop-buffer): Move from + desktop.el. Add Parameters. + 2003-04-18 Steve Youngs <youngs@xemacs.org> * mh-xemacs-icons.el (mh-xemacs-icons): Provide 'mh-xemacs-icons'
--- a/lisp/mh-e/mh-e.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/mh-e/mh-e.el Tue Apr 27 15:53:30 2004 +0000 @@ -1548,6 +1548,8 @@ (make-local-variable 'font-lock-defaults) (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) + (make-local-variable 'desktop-save-buffer) + (setq desktop-save-buffer t) (mh-make-local-vars 'mh-current-folder (buffer-name) ; Name of folder, a string 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
--- a/lisp/paren.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/paren.el Tue Apr 27 15:53:30 2004 +0000 @@ -91,6 +91,9 @@ :group 'faces :group 'paren-showing) +(defvar show-paren-highlight-openparen t + "*Non-nil turns on openparen highlighting when matching forward.") + (defvar show-paren-idle-timer nil) ;;;###autoload @@ -195,7 +198,7 @@ ;; If matching forward, and the openparen is unbalanced, ;; highlight the paren at point to indicate misbalance. ;; Otherwise, turn off any such highlighting. - (if (and (= dir 1) (integerp pos)) + (if (and (not show-paren-highlight-openparen) (= dir 1) (integerp pos)) (when (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1)) (delete-overlay show-paren-overlay-1))
--- a/lisp/pcomplete.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/pcomplete.el Tue Apr 27 15:53:30 2004 +0000 @@ -1,6 +1,6 @@ ;;; pcomplete.el --- programmable completion -;; Copyright (C) 1999, 2000, 2001, 2002 Free Sofware Foundation +;; Copyright (C) 1999, 2000,01,02,03,04 Free Sofware Foundation ;; Author: John Wiegley <johnw@gnu.org> ;; Keywords: processes abbrev @@ -505,7 +505,7 @@ (defsubst pcomplete-actual-arg (&optional index offset) "Return the actual text representation of the last argument. -This different from `pcomplete-arg', which returns the textual value +This is different from `pcomplete-arg', which returns the textual value that the last argument evaluated to. This function returns what the user actually typed in." (buffer-substring (pcomplete-begin index offset) (point))) @@ -531,7 +531,7 @@ (throw 'pcompleted nil)))) (defun pcomplete-match-string (which &optional index offset) - "Like `string-match', but on the current completion argument." + "Like `match-string', but on the current completion argument." (let ((arg (pcomplete-arg (or index 1) offset))) (if arg (match-string which arg) @@ -583,8 +583,8 @@ (defun pcomplete-comint-setup (completef-sym) "Setup a comint buffer to use pcomplete. COMPLETEF-SYM should be the symbol where the -dynamic-complete-functions are kept. For comint mode itself, this is -`comint-dynamic-complete-functions'." +dynamic-complete-functions are kept. For comint mode itself, +this is `comint-dynamic-complete-functions'." (set (make-local-variable 'pcomplete-parse-arguments-function) 'pcomplete-parse-comint-arguments) (make-local-variable completef-sym) @@ -709,7 +709,7 @@ If PREDICATE is non-nil, it will also be used to refine the match \(files for which the PREDICATE returns nil will be excluded). If no directory information can be extracted from the completed -component, DEFAULT-DIRECTORY is used as the basis for completion." +component, `default-directory' is used as the basis for completion." (let* ((name (substitute-env-vars pcomplete-stub)) (default-directory (expand-file-name (or (file-name-directory name) @@ -809,11 +809,10 @@ (defun pcomplete-opt (options &optional prefix no-ganging args-follow) "Complete a set of OPTIONS, each beginning with PREFIX (?- by default). PREFIX may be t, in which case no PREFIX character is necessary. -If REQUIRED is non-nil, the options must be present. -If NO-GANGING is non-nil, each option is separate. -xy is not allowed. -If ARGS-FOLLOW is non-nil, then options which arguments which take may -have the argument appear after a ganged set of options. This is how -tar behaves, for example." +If NO-GANGING is non-nil, each option is separate (-xy is not allowed). +If ARGS-FOLLOW is non-nil, then options which take arguments may have +the argument appear after a ganged set of options. This is how tar +behaves, for example." (if (and (= pcomplete-index pcomplete-last) (string= (pcomplete-arg) "-")) (let ((len (length options)) @@ -864,7 +863,7 @@ (setq index (1+ index)))))))) (defun pcomplete--here (&optional form stub paring form-only) - "Complete aganst the current argument, if at the end. + "Complete against the current argument, if at the end. See the documentation for `pcomplete-here'." (if (< pcomplete-index pcomplete-last) (progn @@ -893,7 +892,7 @@ (throw 'pcomplete-completions (eval form)))) (defmacro pcomplete-here (&optional form stub paring form-only) - "Complete aganst the current argument, if at the end. + "Complete against the current argument, if at the end. If completion is to be done here, evaluate FORM to generate the list of strings which will be used for completion purposes. If STUB is a string, use it as the completion stub instead of the default (which is @@ -913,10 +912,11 @@ If PARING is nil, this argument will be pared against previous arguments using the function `file-truename' to normalize them. -PARING may be a function, in which case that function is for -normalization. If PARING is the value t, the argument dealt with by -this call will not participate in argument paring. If it the integer -0, all previous arguments that have been seen will be cleared. +PARING may be a function, in which case that function is used for +normalization. If PARING is t, the argument dealt with by this +call will not participate in argument paring. If it is the +integer 0, all previous arguments that have been seen will be +cleared. If FORM-ONLY is non-nil, only the result of FORM will be used to generate the completions list. This means that the hook @@ -1129,10 +1129,7 @@ (defun pcomplete--help () "Produce context-sensitive help for the current argument. -If specific documentation can't be given, be generic. -INFODOC specifies the Info node to goto. DOCUMENTATION is a sexp -which will produce documentation for the argument (it is responsible -for displaying in its own buffer)." +If specific documentation can't be given, be generic." (if (and pcomplete-help (or (and (stringp pcomplete-help) (fboundp 'Info-goto-node))
--- a/lisp/progmodes/compile.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/progmodes/compile.el Tue Apr 27 15:53:30 2004 +0000 @@ -184,7 +184,7 @@ ;; fixme: should be `mips' (irix - "^[-[:alnum:]_/]+: \\(?:[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\ + "^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\ \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) (java @@ -587,10 +587,9 @@ "Get the meta-info that will be added as text-properties. LINE, END-LINE, COL, END-COL are integers or nil. TYPE can be 0, 1, or 2. -FILE should be (FILENAME . DIRNAME) or nil." +FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil." (unless file (setq file '("*unknown*"))) - (setq file (or (gethash file compilation-locs) - (puthash file (list file fmt) compilation-locs))) + (setq file (compilation-get-file-structure file fmt)) ;; Get first already existing marker (if any has one, all have one). ;; Do this first, as the compilation-assq`s may create new nodes. (let* ((marker-line (car (cddr file))) ; a line structure @@ -599,19 +598,17 @@ end-marker loc end-loc) (if (not (and marker (marker-buffer marker))) (setq marker) ; no valid marker for this file - (setq loc (or line 1) ; normalize no linenumber to line 1 - marker-line) - (catch 'marker ; find nearest loc, at least one exists - (dolist (x (cddr file)) ; loop over lines - (if (> (or (car x) 1) loc) ; still bigger + (setq loc (or line 1)) ; normalize no linenumber to line 1 + (catch 'marker ; find nearest loc, at least one exists + (dolist (x (nthcdr 3 file)) ; loop over remaining lines + (if (> (car x) loc) ; still bigger (setq marker-line x) - (if (or (not marker-line) ; first in list - (> (- (or (car marker-line) 1) loc) - (- loc (or (car x) 1)))) ; current line is nearer + (if (> (- (or (car marker-line) 1) loc) + (- loc (car x))) ; current line is nearer (setq marker-line x)) (throw 'marker t)))) (setq marker (nth 3 (cadr marker-line)) - marker-line (car marker-line)) + marker-line (or (car marker-line) 1)) (with-current-buffer (marker-buffer marker) (save-restriction (widen) @@ -1451,6 +1448,7 @@ (defun compilation-fake-loc (marker file &optional line col) "Preassociate MARKER with FILE. +FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME). This is useful when you compile temporary files, but want automatic translation of the messages to the real buffer from which the temporary file came. This only works if done before a @@ -1466,13 +1464,12 @@ call this several times, once each for the last line of one region and the first line of the next region." (or (consp file) (setq file (list file))) - (setq file (or (gethash file compilation-locs) - (puthash file (list file nil) compilation-locs))) + (setq file (compilation-get-file-structure file)) (let ((loc (compilation-assq (or line 1) (cdr file)))) (setq loc (compilation-assq col loc)) (if (cdr loc) (setcdr (cddr loc) (list marker)) - (setcdr loc (list (or line 1) file marker))) + (setcdr loc (list line file marker))) loc)) (defcustom compilation-context-lines next-screen-context-lines @@ -1598,67 +1595,58 @@ (overlays-in (point-min) (point-max))) buffer))) -(defun compilation-normalize-filename (filename) - "Convert FILENAME string found in an error message to make it usable." - - ;; Check for a comint-file-name-prefix and prepend it if - ;; appropriate. (This is very useful for - ;; compilation-minor-mode in an rlogin-mode buffer.) - (and (boundp 'comint-file-name-prefix) - ;; If file name is relative, default-directory will - ;; already contain the comint-file-name-prefix (done - ;; by compile-abbreviate-directory). - (file-name-absolute-p filename) - (setq filename - (concat (with-no-warnings 'comint-file-name-prefix) filename))) +(defun compilation-get-file-structure (file &optional fmt) + "Retrieve FILE's file-structure or create a new one. +FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)." - ;; If compilation-parse-errors-filename-function is - ;; defined, use it to process the filename. - (when compilation-parse-errors-filename-function - (setq filename - (funcall compilation-parse-errors-filename-function - filename))) + (or (gethash file compilation-locs) + ;; File was not previously encountered, at least not in the form passed. + ;; Let's normalize it and look again. + (let ((filename (car file)) + (default-directory (if (cdr file) + (file-truename (cdr file)) + default-directory))) - ;; Some compilers (e.g. Sun's java compiler, reportedly) - ;; produce bogus file names like "./bar//foo.c" for file - ;; "bar/foo.c"; expand-file-name will collapse these into - ;; "/foo.c" and fail to find the appropriate file. So we - ;; look for doubled slashes in the file name and fix them - ;; up in the buffer. - (setq filename (command-line-normalize-file-name filename))) - + ;; Check for a comint-file-name-prefix and prepend it if appropriate. + ;; (This is very useful for compilation-minor-mode in an rlogin-mode + ;; buffer.) + (if (boundp 'comint-file-name-prefix) + (if (file-name-absolute-p filename) + (setq filename + (concat (with-no-warnings comint-file-name-prefix) filename)) + (setq default-directory + (file-truename + (concat (with-no-warnings comint-file-name-prefix) default-directory))))) -;; If directory DIR is a subdir of ORIG or of ORIG's parent, -;; return a relative name for it starting from ORIG or its parent. -;; ORIG-EXPANDED is an expanded version of ORIG. -;; PARENT-EXPANDED is an expanded version of ORIG's parent. -;; Those two args could be computed here, but we run faster by -;; having the caller compute them just once. -(defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded) - ;; Apply canonical abbreviations to DIR first thing. - ;; Those abbreviations are already done in the other arguments passed. - (setq dir (abbreviate-file-name dir)) + ;; If compilation-parse-errors-filename-function is + ;; defined, use it to process the filename. + (when compilation-parse-errors-filename-function + (setq filename + (funcall compilation-parse-errors-filename-function + filename))) + + ;; Some compilers (e.g. Sun's java compiler, reportedly) produce bogus + ;; file names like "./bar//foo.c" for file "bar/foo.c"; + ;; expand-file-name will collapse these into "/foo.c" and fail to find + ;; the appropriate file. So we look for doubled slashes in the file + ;; name and fix them. + (setq filename (command-line-normalize-file-name filename)) - ;; Check for a comint-file-name-prefix and prepend it if appropriate. - ;; (This is very useful for compilation-minor-mode in an rlogin-mode - ;; buffer.) - (if (boundp 'comint-file-name-prefix) - (setq dir (concat comint-file-name-prefix dir))) + ;; Now eliminate any "..", because find-file would get them wrong. + ;; Make relative and absolute filenames, with or without links, the + ;; same. + (setq filename + (list (abbreviate-file-name + (file-truename (if (cdr file) + (expand-file-name filename) + filename))))) - (if (and (> (length dir) (length orig-expanded)) - (string= orig-expanded - (substring dir 0 (length orig-expanded)))) - (setq dir - (concat orig - (substring dir (length orig-expanded))))) - (if (and (> (length dir) (length parent-expanded)) - (string= parent-expanded - (substring dir 0 (length parent-expanded)))) - (setq dir - (concat (file-name-directory - (directory-file-name orig)) - (substring dir (length parent-expanded))))) - dir) + ;; Store it for the possibly unnormalized name + (puthash file + ;; Retrieve or create file-structure for normalized name + (or (gethash filename compilation-locs) + (puthash filename (list filename fmt) compilation-locs)) + compilation-locs)))) (add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")
--- a/lisp/progmodes/gud.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/progmodes/gud.el Tue Apr 27 15:53:30 2004 +0000 @@ -1401,7 +1401,7 @@ output)) -(defcustom gud-pdb-command-name "pdb" +(defcustom gud-pdb-command-name "pydb" "File name for executing the Python debugger. This should be an executable on your path, or an absolute file name." :type 'string
--- a/lisp/progmodes/sh-script.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/progmodes/sh-script.el Tue Apr 27 15:53:30 2004 +0000 @@ -648,7 +648,7 @@ (rc "else") - (sh "do" "elif" "else" "if" "then" "trap" "type" "until" "while")) + (sh "!" "do" "elif" "else" "if" "then" "trap" "type" "until" "while")) "*List of keywords that may be immediately followed by a builtin or keyword. Given some confusion between keywords and builtins depending on shell and system, the distinction here has been based on whether they influence the
--- a/lisp/simple.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/simple.el Tue Apr 27 15:53:30 2004 +0000 @@ -2152,7 +2152,7 @@ ;; Swap point and mark. (set-marker (mark-marker) (point) (current-buffer)) (goto-char other-end) - (sit-for 1) + (sit-for blink-matching-delay) ;; Swap back. (set-marker (mark-marker) other-end (current-buffer)) (goto-char opoint) @@ -4262,7 +4262,10 @@ (defface completions-common-part '((t (:inherit default))) - "Face put on the common prefix substring in completions in *Completions* buffer." + "Face put on the common prefix substring in completions in *Completions* buffer. +The idea of `completions-common-part' is that you can use it to +make the common parts less visible than normal, so that the rest +of the differing parts is, by contrast, slightly highlighted." :group 'completion) (defun completion-setup-function ()
--- a/lisp/textmodes/picture.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/textmodes/picture.el Tue Apr 27 15:53:30 2004 +0000 @@ -636,7 +636,15 @@ (define-key picture-mode-map "\C-c`" 'picture-movement-nw) (define-key picture-mode-map "\C-c'" 'picture-movement-ne) (define-key picture-mode-map "\C-c/" 'picture-movement-sw) - (define-key picture-mode-map "\C-c\\" 'picture-movement-se))) + (define-key picture-mode-map "\C-c\\" 'picture-movement-se) + (define-key picture-mode-map [(control ?c) left] 'picture-movement-left) + (define-key picture-mode-map [(control ?c) right] 'picture-movement-right) + (define-key picture-mode-map [(control ?c) up] 'picture-movement-up) + (define-key picture-mode-map [(control ?c) down] 'picture-movement-down) + (define-key picture-mode-map [(control ?c) home] 'picture-movement-nw) + (define-key picture-mode-map [(control ?c) prior] 'picture-movement-ne) + (define-key picture-mode-map [(control ?c) end] 'picture-movement-sw) + (define-key picture-mode-map [(control ?c) next] 'picture-movement-se))) (defcustom picture-mode-hook nil "If non-nil, its value is called on entry to Picture mode.
--- a/lisp/vc-hooks.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/vc-hooks.el Tue Apr 27 15:53:30 2004 +0000 @@ -44,8 +44,8 @@ "set `vc-handled-backends' to nil to disable VC.") (defvar vc-master-templates ()) -(make-obsolete-variable 'vc-master-templates - "to define master templates for a given BACKEND, use +(make-obsolete-variable 'vc-master-templates + "to define master templates for a given BACKEND, use vc-BACKEND-master-templates. To enable or disable VC for a given BACKEND, use `vc-handled-backends'.") @@ -474,8 +474,8 @@ (indirect-function (vc-find-backend-function (vc-backend file) 'diff)))) - (not (eq (caddr err) 5))) - (signal 'wrong-number-of-arguments err) + (not (eq (caddr err) 4))) + (signal (car err) (cdr err)) (vc-call diff file)))))) (defun vc-workfile-version (file)
--- a/lisp/vc.el Fri Apr 23 14:44:11 2004 +0000 +++ b/lisp/vc.el Tue Apr 27 15:53:30 2004 +0000 @@ -2357,11 +2357,11 @@ ;; without the optional buffer argument (for backward compatibility). ;; Otherwise, resignal. (if (or (not (eq (cadr err) - (indirect-function - (vc-find-backend-function (vc-backend file) + (indirect-function + (vc-find-backend-function (vc-backend file) 'print-log)))) (not (eq (caddr err) 2))) - (signal 'wrong-number-of-arguments err) + (signal (car err) (cdr err)) ;; for backward compatibility (vc-call print-log file) (set-buffer "*vc*"))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/wdired.el Tue Apr 27 15:53:30 2004 +0000 @@ -0,0 +1,872 @@ +;;; wdired.el --- Rename files editing their names in dired buffers + +;; Copyright (C) 2001, 2004 Free Software Foundation, Inc. + +;; Filename: wdired.el +;; Author: Juan León Lahoz GarcÃa <juan-leon.lahoz@tecsidel.es> +;; Version: 1.91 +;; Keywords: dired, environment, files, renaming + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; wdired.el (the "w" is for writable) provides an alternative way of +;; renaming files. +;; +;; Have you ever wished to use C-x r t (string-rectangle), M-% +;; (query-replace), M-c (capitalize-word), etc. to change the name of +;; the files in a "dired" buffer? Now you can do this. All the power +;; of emacs commands are available to renaming files! +;; +;; This package provides a function that makes the filenames of a a +;; dired buffer editable, by changing the buffer mode (which inhibits +;; all of the commands of dired mode). Here you can edit the names of +;; one or more files and directories, and when you press C-c C-c, the +;; renaming takes effect and you are back to dired mode. +;; +;; Another things you can do with wdired: +;; +;; - To move files to another directory (by typing their path, +;; absolute or relative, as a part of the new filename). +;; +;; - To change the target of symbolic links. +;; +;; - To change the permission bits of the filenames (in systems with a +;; working unix-alike `dired-chmod-program'). See and customize the +;; variable `wdired-allow-to-change-permissions'. To change a single +;; char (toggling between its two more usual values) you can press +;; the space bar over it or left-click the mouse. To set any char to +;; an specific value (this includes the SUID, SGID and STI bits) you +;; can use the key labeled as the letter you want. Please note that +;; permissions of the links cannot be changed in that way, because +;; the change would affect to their targets, and this would not be +;; WYSIWYG :-). +;; +;; - To mark files for deletion, by deleting their whole filename. +;; +;; I do not have a URL to hang wdired, but you can use the one below +;; to find the latest version: +;; +;; http://groups.google.com/groups?as_ugroup=gnu.emacs.sources&as_q=wdired + +;;; Installation: + +;; Add this file (byte-compiling it is recommended) to your load-path. +;; Then add one of these set of lines (or similar ones) to your config: +;; +;; This is the easy way: +;; +;; (require 'wdired) +;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode) +;; +;; This is recommended way for faster emacs startup time and lower +;; memory consumption, but remind to add these lines before dired.el +;; gets loaded (i.e., near the beginning of your .emacs file): +;; +;; (autoload 'wdired-change-to-wdired-mode "wdired") +;; (add-hook 'dired-load-hook +;; '(lambda () +;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode) +;; (define-key dired-mode-map +;; [menu-bar immediate wdired-change-to-wdired-mode] +;; '("Edit File Names" . wdired-change-to-wdired-mode)))) +;; +;; +;; Type "M-x customize-group RET wdired" if you want make changes to +;; the default behavior. + +;;; Usage: + +;; Then, you can start editing the names of the files by typing "r" +;; (or whatever key you choose, or M-x wdired-change-to-wdired-mode). +;; Use C-c C-c when finished or C-c C-k to abort. You can use also the +;; menu options: in dired mode, "Edit File Names" under "Immediate". +;; While editing the names, a new submenu "WDired" is available at top +;; level. You can customize the behavior of this package from this +;; menu. + +;;; Change Log: + +;; From 1.9 to 1.91 +;; +;; - Fixed a bug (introduced in 1.9) so now files can be marked for +;; deletion again, by deleting their whole filename. + +;; From 1.8 to 1.9 +;; +;; - Another alternative way of editing permissions allowed, see +;; `wdired-allow-to-change-permissions' for details. +;; +;; - Now wdired doesn't rely on regexp so much. As a consequence of +;; this, you can add newlines to filenames and symlinks targets +;; (although this is not very usual, IMHO). Please note that dired +;; (at least in Emacs 21.1 and previous) does not work very well +;; with filenames with newlines in them, so RET is deactivated in +;; wdired mode. But you can activate it if you want. +;; +;; - Now `upcase-word' `capitalize-word' and `downcase-word' are not +;; advised to work better with wdired mode, but the keys bound to +;; them use wdired versions of those commands. +;; +;; - Now "undo" actions are not inherited from wdired mode when +;; changing to dired mode. +;; +;; - Code and documentation cleanups. +;; +;; - Fixed a bug that was making wdired to fail on users with +;; `dired-backup-overwrite' set to t. +;; +;; - C-c C-[ now abort changes. + +;; From 1.7 to 1.8 +;; +;; - Now permission (access-control) bits of the files can be changed. +;; Please see the commentary section and the custom variable +;; `wdired-allow-to-change-permissions' for details. +;; +;; - Added another possible value for the variable +;; `wdired-always-move-to-filename-beginning', useful to change +;; permission bits of several files without the cursor jumping to +;; filenames when changing lines. + +;; From 0.1 to 1.7 + +;; - I've moved the list of changes to another file, because it was +;; huge. Ask me for it or search older versions in google. + +;;; TODO: + +;; - Make it to work in XEmacs. Any volunteer? + +;;; Code: + +(eval-when-compile + (require 'advice) + (defvar dired-backup-overwrite) ; Only in emacs 20.x this is a custom var + (set (make-local-variable 'byte-compile-dynamic) t)) + +(eval-and-compile + (require 'dired) + (autoload 'dired-do-create-files-regexp "dired-aux") + (autoload 'dired-call-process "dired-aux")) + +(defgroup wdired nil + "Mode to rename files by editing their names in dired buffers." + :group 'dired) + +(defcustom wdired-use-interactive-rename nil + "*If t, confirmation is required before actually rename the files. +Confirmation is required also for overwriting files. If nil, no +confirmation is required for change the file names, and the variable +`wdired-is-ok-overwrite' is used to see if it is ok to overwrite files +without asking." + :type 'boolean + :group 'wdired) + +(defcustom wdired-is-ok-overwrite nil + "*If non-nil the renames can overwrite files without asking. +This variable is used only if `wdired-use-interactive-rename' is nil." + :type 'boolean + :group 'wdired) + +(defcustom wdired-always-move-to-filename-beginning nil + "*If t the \"up\" and \"down\" movement is done as in dired mode. +That is, always move the point to the beginning of the filename at line. + +If `sometimes, only move to the beginning of filename if the point is +before it, and `track-eol' is honored. This behavior is very handy +when editing several filenames. + +If nil, \"up\" and \"down\" movement is done as in any other buffer." + :type '(choice (const :tag "As in any other mode" nil) + (const :tag "Smart cursor placement" sometimes) + (other :tag "As in dired mode" t)) + :group 'wdired) + +(defcustom wdired-advise-functions t + "*If t some editing commands are advised when wdired is loaded. +The advice only has effect in wdired mode. These commands are +`query-replace' `query-replace-regexp' `replace-string', and the +advice makes them to ignore read-only regions, so no attempts to +modify these regions are done by them, and so they don't end +prematurely. + +Setting this to nil does not unadvise the functions, if they are +already advised, but new Emacs will not advise them." + :type 'boolean + :group 'wdired) + +(defcustom wdired-allow-to-redirect-links t + "*If non-nil, the target of the symbolic links can be changed also. +In systems without symbolic links support, this variable has no effect +at all." + :type 'boolean + :group 'wdired) + +(defcustom wdired-allow-to-change-permissions nil + "*If non-nil, the permissions bits of the files can be changed also. + +If t, to change a single bit, put the cursor over it and press the +space bar, or left click over it. You can also hit the letter you want +to set: if this value is allowed, the character in the buffer will be +changed. Anyway, the point is advanced one position, so, for example, +you can keep the \"x\" key pressed to give execution permissions to +everybody to that file. + +If `advanced, the bits are freely editable. You can use +`string-rectangle', `query-replace', etc. You can put any value (even +newlines), but if you want your changes to be useful, you better put a +intelligible value. + +Anyway, the real change of the permissions is done with the external +program `dired-chmod-program', which must exist." + :type '(choice (const :tag "Not allowed" nil) + (const :tag "Toggle/set bits" t) + (other :tag "Bits freely editable" advanced)) + :group 'wdired) + +(defvar wdired-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-x\C-s" 'wdired-finish-edit) + (define-key map "\C-c\C-c" 'wdired-finish-edit) + (define-key map "\C-c\C-k" 'wdired-abort-changes) + (define-key map "\C-c\C-[" 'wdired-abort-changes) + (define-key map "\C-m" 'wdired-newline) + (define-key map "\C-j" 'wdired-newline) + (define-key map "\C-o" 'wdired-newline) + (define-key map [up] 'wdired-previous-line) + (define-key map "\C-p" 'wdired-previous-line) + (define-key map [down] 'wdired-next-line) + (define-key map "\C-n" 'wdired-next-line) + + (define-key map [menu-bar wdired] + (cons "WDired" (make-sparse-keymap "WDired"))) + (define-key map [menu-bar wdired wdired-customize] + '("Options" . wdired-customize)) + (define-key map [menu-bar wdired dashes] + '("--")) + (define-key map [menu-bar wdired wdired-abort-changes] + '("Abort Changes" . wdired-abort-changes)) + (define-key map [menu-bar wdired wdired-finish-edit] + '("Commit Changes" . wdired-finish-edit)) + ;; FIXME: Use the new remap trick. + (substitute-key-definition 'upcase-word 'wdired-upcase-word + map global-map) + (substitute-key-definition 'capitalize-word 'wdired-capitalize-word + map global-map) + (substitute-key-definition 'downcase-word 'wdired-downcase-word + map global-map) + map)) + +(defvar wdired-mode-hook nil + "Hook run when changing to wdired mode.") + +;; Local variables (put here to avoid compilation gripes) +(defvar wdired-col-perm) ;; Column where the permission bits start +(defvar wdired-old-content) + + +(defun wdired-mode () + "\\<wdired-mode-map>File Names Editing mode. + +Press \\[wdired-finish-edit] to make the changes to take effect and +exit. To abort the edit, use \\[wdired-abort-changes]. + +In this mode you can edit the names of the files, the target of the +links and the permission bits of the files. You can `customize-group' +wdired. + +Editing things out of the filenames, or adding or deleting lines is +not allowed, because the rest of the buffer is read-only." + (interactive) + (error "This mode can be enabled only by `wdired-change-to-wdired-mode'")) +(put 'wdired-mode 'mode-class 'special) + + +;;;###autoload +(defun wdired-change-to-wdired-mode () + "Put a dired buffer in a mode in which filenames are editable. +In this mode the names of the files can be changed, and after +typing C-c C-c the files and directories in disk are renamed. + +See `wdired-mode'." + (interactive) + (set (make-local-variable 'wdired-old-content) + (buffer-substring (point-min) (point-max))) + (use-local-map wdired-mode-map) + (force-mode-line-update) + (setq buffer-read-only nil) + (dired-unadvertise default-directory) + (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t) + (setq major-mode 'wdired-mode) + (setq mode-name "Edit filenames") + (setq revert-buffer-function 'wdired-revert) + ;; I temp disable undo for performance: since I'm going to clear the + ;; undo list, it can save more than a 9% of time with big + ;; directories because setting properties modify the undo-list. + (buffer-disable-undo) + (wdired-preprocess-files) + (if wdired-allow-to-change-permissions + (wdired-preprocess-perms)) + (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link)) + (wdired-preprocess-symlinks)) + (buffer-enable-undo) ; Performance hack. See above. + (set-buffer-modified-p nil) + (setq buffer-undo-list nil) + (run-hooks wdired-mode-hook) + (message "Press C-c C-c when finished")) + + +;; Protect the buffer so only the filenames can be changed, and put +;; properties so filenames (old and new) can be easily found. +(defun wdired-preprocess-files () + (put-text-property 1 2 'front-sticky t) + (save-excursion + (goto-char (point-min)) + (let ((b-protection (point)) + filename) + (while (not (eobp)) + (setq filename (dired-get-filename nil t)) + (when (and filename + (not (member (file-name-nondirectory filename) '("." "..")))) + (dired-move-to-filename) + (put-text-property (- (point) 2) (1- (point)) 'old-name filename) + (put-text-property b-protection (1- (point)) 'read-only t) + (setq b-protection (dired-move-to-end-of-filename t))) + (put-text-property (point) (1+ (point)) 'end-name t) + (forward-line)) + (put-text-property b-protection (point-max) 'read-only t)))) + +;; This code is a copy of some dired-get-filename lines. +(defsubst wdired-normalize-filename (file) + (setq file + ;; FIXME: shouldn't we check for a `b' argument or somesuch before + ;; doing such unquoting? --Stef + (read (concat + "\"" (replace-regexp-in-string + "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file) + "\""))) + (and file buffer-file-coding-system + (not file-name-coding-system) + (not default-file-name-coding-system) + (setq file (encode-coding-string file buffer-file-coding-system))) + file) + +(defun wdired-get-filename (&optional no-dir old) + "Return the filename at line. +Similar to `dired-get-filename' but it doesn't rely on regexps. It +relies on wdired buffer's properties. Optional arg NO-DIR with value +non-nil means don't include directory. Optional arg OLD with value +non-nil means return old filename." + ;; FIXME: Use dired-get-filename's new properties. + (let (beg end file) + (save-excursion + (setq end (progn (end-of-line) (point))) + (beginning-of-line) + (setq beg (next-single-property-change (point) 'old-name nil end)) + (unless (eq beg end) + (if old + (setq file (get-text-property beg 'old-name)) + (setq end (next-single-property-change (1+ beg) 'end-name)) + (setq file (buffer-substring-no-properties (+ 2 beg) end))) + (and file (setq file (wdired-normalize-filename file)))) + (if (or no-dir old) + file + (and file (> (length file) 0) + (concat (dired-current-directory) file)))))) + + +(defun wdired-change-to-dired-mode () + "Change the mode back to dired." + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) + '(read-only nil local-map nil))) + (put-text-property 1 2 'front-sticky nil) + (use-local-map dired-mode-map) + (force-mode-line-update) + (setq buffer-read-only t) + (setq major-mode 'dired-mode) + (setq mode-name "Dired") + (dired-advertise) + (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t) + (setq revert-buffer-function 'dired-revert)) + + +(defun wdired-abort-changes () + "Abort changes and return to dired mode." + (interactive) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert wdired-old-content)) + (wdired-change-to-dired-mode) + (set-buffer-modified-p nil) + (setq buffer-undo-list nil)) + +(defun wdired-finish-edit () + "Actually rename files based on your editing in the Dired buffer." + (interactive) + (wdired-change-to-dired-mode) + (let ((overwrite (or wdired-is-ok-overwrite 1)) + (changes nil) + (files-deleted nil) + (errors 0) + file-ori file-new tmp-value) + (save-excursion + (if (and wdired-allow-to-redirect-links + (fboundp 'make-symbolic-link)) + (progn + (setq tmp-value (wdired-do-symlink-changes)) + (setq errors (cdr tmp-value)) + (setq changes (car tmp-value)))) + (if (and wdired-allow-to-change-permissions + (boundp 'wdired-col-perm)) ; could have been changed + (progn + (setq tmp-value (wdired-do-perm-changes)) + (setq errors (+ errors (cdr tmp-value))) + (setq changes (or changes (car tmp-value))))) + (goto-char (point-max)) + (while (not (bobp)) + (setq file-ori (wdired-get-filename nil t)) + (if file-ori + (setq file-new (wdired-get-filename))) + (if (and file-ori (not (equal file-new file-ori))) + (progn + (setq changes t) + (if (not file-new) ;empty filename! + (setq files-deleted (cons file-ori files-deleted)) + (progn + (setq file-new (substitute-in-file-name file-new)) + (if wdired-use-interactive-rename + (wdired-search-and-rename file-ori file-new) + (condition-case err + (let ((dired-backup-overwrite nil)) + (dired-rename-file file-ori file-new + overwrite)) + (error + (setq errors (1+ errors)) + (dired-log (concat "Rename `" file-ori "' to `" + file-new "' failed:\n%s\n") + err)))))))) + (forward-line -1))) + (if changes + (revert-buffer) ;The "revert" is necessary to re-sort the buffer + (let ((buffer-read-only nil)) + (remove-text-properties (point-min) (point-max) + '(old-name nil end-name nil old-link nil + end-link nil end-perm nil + old-perm nil perm-changed nil)) + (message "(No changes to be performed)"))) + (if files-deleted + (wdired-flag-for-deletion files-deleted)) + (if (> errors 0) + (dired-log-summary (format "%d rename actions failed" errors) nil))) + (set-buffer-modified-p nil) + (setq buffer-undo-list nil)) + +;; Renames a file, searching it in a modified dired buffer, in order +;; to be able to use `dired-do-create-files-regexp' and get its +;; "benefits" +(defun wdired-search-and-rename (filename-ori filename-new) + (save-excursion + (goto-char (point-max)) + (forward-line -1) + (let ((exit-while nil) + curr-filename) + (while (not exit-while) + (setq curr-filename (wdired-get-filename)) + (if (and curr-filename + (equal (substitute-in-file-name curr-filename) filename-new)) + (progn + (setq exit-while t) + (let ((inhibit-read-only t)) + (dired-move-to-filename) + (search-forward (wdired-get-filename t) nil t) + (replace-match (file-name-nondirectory filename-ori) t t)) + (dired-do-create-files-regexp + (function dired-rename-file) + "Move" 1 ".*" filename-new nil t)) + (progn + (forward-line -1) + (beginning-of-line) + (setq exit-while (= 1 (point))))))))) + +;; marks a list of files for deletion +(defun wdired-flag-for-deletion (filenames-ori) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (if (member (dired-get-filename nil t) filenames-ori) + (dired-flag-file-deletion 1) + (forward-line))))) + +(defun wdired-customize () + "Customize wdired options." + (interactive) + (customize-apropos "wdired" 'groups)) + +(defun wdired-revert (&optional arg noconfirm) + "Discard changes in the buffer and update the changes in the disk." + (wdired-change-to-dired-mode) + (revert-buffer) + (wdired-change-to-wdired-mode)) + +(defun wdired-check-kill-buffer () + ;; FIXME: Can't we use the normal mechanism for that? --Stef + (if (and + (buffer-modified-p) + (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? "))) + (error nil))) + +(defun wdired-next-line (arg) + "Move down lines then position at filename or the current column. +See `wdired-always-move-to-filename-beginning'. Optional prefix ARG +says how many lines to move; default is one line." + (interactive "p") + (next-line arg) + (if (or (eq wdired-always-move-to-filename-beginning t) + (and wdired-always-move-to-filename-beginning + (< (current-column) + (save-excursion (dired-move-to-filename) + (current-column))))) + (dired-move-to-filename))) + +(defun wdired-previous-line (arg) + "Move up lines then position at filename or the current column. +See `wdired-always-move-to-filename-beginning'. Optional prefix ARG +says how many lines to move; default is one line." + (interactive "p") + (previous-line arg) + (if (or (eq wdired-always-move-to-filename-beginning t) + (and wdired-always-move-to-filename-beginning + (< (current-column) + (save-excursion (dired-move-to-filename) + (current-column))))) + (dired-move-to-filename))) + +;; dired doesn't works well with newlines, so ... +(defun wdired-newline () + "Do nothing." + (interactive)) + +;; Put the needed properties to allow the user to change links' targets +(defun wdired-preprocess-symlinks () + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (if (looking-at dired-re-sym) + (progn + (re-search-forward " -> \\(.*\\)$") + (put-text-property (- (match-beginning 1) 2) + (1- (match-beginning 1)) 'old-link + (match-string-no-properties 1)) + (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t) + (put-text-property (1- (match-beginning 1)) + (match-end 1) 'read-only nil))) + (forward-line) + (beginning-of-line))))) + + +(defun wdired-get-previous-link (&optional old move) + "Return the next symlink target. +If OLD, return the old target. If MOVE, move point before it." + (let (beg end target) + (setq beg (previous-single-property-change (point) 'old-link nil)) + (if beg + (progn + (if old + (setq target (get-text-property (1- beg) 'old-link)) + (setq end (next-single-property-change beg 'end-link)) + (setq target (buffer-substring-no-properties (1+ beg) end))) + (if move (goto-char (1- beg))))) + (and target (wdired-normalize-filename target)))) + + + +;; Perform the changes in the target of the changed links. +(defun wdired-do-symlink-changes() + (let ((changes nil) + (errors 0) + link-to-ori link-to-new link-from) + (goto-char (point-max)) + (while (setq link-to-new (wdired-get-previous-link)) + (setq link-to-ori (wdired-get-previous-link t t)) + (setq link-from (wdired-get-filename nil t)) + (if (not (equal link-to-new link-to-ori)) + (progn + (setq changes t) + (if (equal link-to-new "") ;empty filename! + (setq link-to-new "/dev/null")) + (condition-case err + (progn + (delete-file link-from) + (make-symbolic-link + (substitute-in-file-name link-to-new) link-from)) + (error + (setq errors (1+ errors)) + (dired-log (concat "Link `" link-from "' to `" + link-to-new "' failed:\n%s\n") + err)))))) + (cons changes errors))) + +;; Perform a "case command" skipping read-only words. +(defun wdired-xcase-word (command arg) + (if (< arg 0) + (funcall command arg) + (progn + (while (> arg 0) + (condition-case err + (progn + (funcall command 1) + (setq arg (1- arg))) + (error + (if (not (forward-word 1)) + (setq arg 0)))))))) + +(defun wdired-downcase-word (arg) + "Wdired version of `downcase-word'. +Like original function but it skips read-only words." + (interactive "p") + (wdired-xcase-word 'downcase-word arg)) + +(defun wdired-upcase-word (arg) + "Wdired version of `upcase-word'. +Like original function but it skips read-only words." + (interactive "p") + (wdired-xcase-word 'upcase-word arg)) + +(defun wdired-capitalize-word (arg) + "Wdired version of `capitalize-word'. +Like original function but it skips read-only words." + (interactive "p") + (wdired-xcase-word 'capitalize-word arg)) + +;; The following code is related to advice some interactive functions +;; to make some editing commands in wdired mode not to fail trying to +;; change read-only text. Notice that some advises advice and unadvise +;; them-self to another functions: search-forward and +;; re-search-forward. This is to keep these functions advised only +;; when is necessary. Since they are built-in commands used heavily in +;; lots of places, to have it permanently advised would cause some +;; performance loss. + + +(defun wdired-add-skip-in-replace (command) + "Advice COMMAND to skip matches while they have read-only properties. +This is useful to avoid \"read-only\" errors in search and replace +commands. This advice only has effect in wdired mode." + (eval + `(defadvice ,command (around wdired-discard-read-only activate) + ,(format "Make %s to work better with wdired,\n%s." command + "skipping read-only matches when invoked without argument") + ad-do-it + (if (eq major-mode 'wdired-mode) + (while (and ad-return-value + (text-property-any + (max 1 (1- (match-beginning 0))) (match-end 0) + 'read-only t)) + ad-do-it)) + ad-return-value))) + + +(defun wdired-add-replace-advice (command) + "Advice COMMAND to skip matches while they have read-only properties. +This is useful to avoid \"read-only\" errors in search and replace +commands. This advice only has effect in wdired mode." + (eval + `(defadvice ,command (around wdired-grok-read-only activate) + ,(format "Make %s to work better with wdired,\n%s." command + "skipping read-only matches when invoked without argument") + (if (eq major-mode 'wdired-mode) + (progn + (wdired-add-skip-in-replace 'search-forward) + (wdired-add-skip-in-replace 're-search-forward) + (unwind-protect + ad-do-it + (progn + (ad-remove-advice 'search-forward + 'around 'wdired-discard-read-only) + (ad-remove-advice 're-search-forward + 'around 'wdired-discard-read-only) + (ad-update 'search-forward) + (ad-update 're-search-forward)))) + ad-do-it) + ad-return-value))) + + +(if wdired-advise-functions + (progn + (mapcar 'wdired-add-replace-advice + '(query-replace query-replace-regexp replace-string)))) + + +;; The following code deals with changing the access bits (or +;; permissions) of the files. + +(defvar wdired-perm-mode-map nil) +(unless wdired-perm-mode-map + (setq wdired-perm-mode-map (copy-keymap wdired-mode-map)) + (define-key wdired-perm-mode-map " " 'wdired-toggle-bit) + (define-key wdired-perm-mode-map "r" 'wdired-set-bit) + (define-key wdired-perm-mode-map "w" 'wdired-set-bit) + (define-key wdired-perm-mode-map "x" 'wdired-set-bit) + (define-key wdired-perm-mode-map "-" 'wdired-set-bit) + (define-key wdired-perm-mode-map "S" 'wdired-set-bit) + (define-key wdired-perm-mode-map "s" 'wdired-set-bit) + (define-key wdired-perm-mode-map "T" 'wdired-set-bit) + (define-key wdired-perm-mode-map "t" 'wdired-set-bit) + (define-key wdired-perm-mode-map "s" 'wdired-set-bit) + (define-key wdired-perm-mode-map "l" 'wdired-set-bit) + (define-key wdired-perm-mode-map [down-mouse-1] 'wdired-mouse-toggle-bit)) + +;; Put a local-map to the permission bits of the files, and store the +;; original name and permissions as a property +(defun wdired-preprocess-perms() + (let ((inhibit-read-only t) + filename) + (set (make-local-variable 'wdired-col-perm) nil) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (if (and (not (looking-at dired-re-sym)) + (setq filename (wdired-get-filename))) + (progn + (re-search-forward dired-re-perms) + (or wdired-col-perm + (setq wdired-col-perm (- (current-column) 9))) + (if (eq wdired-allow-to-change-permissions 'advanced) + (put-text-property (match-beginning 0) (match-end 0) + 'read-only nil) + (put-text-property (1+ (match-beginning 0)) (match-end 0) + 'local-map wdired-perm-mode-map)) + (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t) + (put-text-property (match-beginning 0) (1+ (match-beginning 0)) + 'old-perm (match-string-no-properties 0)))) + (forward-line) + (beginning-of-line))))) + +(defun wdired-perm-allowed-in-pos (char pos) + (cond + ((= char ?-) t) + ((= char ?r) (= (% pos 3) 0)) + ((= char ?w) (= (% pos 3) 1)) + ((= char ?x) (= (% pos 3) 2)) + ((memq char '(?s ?S)) (memq pos '(2 5))) + ((memq char '(?t ?T)) (= pos 8)) + ((= char ?l) (= pos 5)))) + +(defun wdired-set-bit () + "Set a permission bit character." + (interactive) + (if (wdired-perm-allowed-in-pos last-command-char + (- (current-column) wdired-col-perm)) + (let ((new-bit (char-to-string last-command-char)) + (inhibit-read-only t) + (pos-prop (- (point) (- (current-column) wdired-col-perm)))) + (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit) + (put-text-property 0 1 'read-only t new-bit) + (insert new-bit) + (delete-char 1) + (put-text-property pos-prop (1- pos-prop) 'perm-changed t)) + (forward-char 1))) + +(defun wdired-toggle-bit() + "Toggle the permission bit at point." + (interactive) + (let ((inhibit-read-only t) + (new-bit "-") + (pos-prop (- (point) (- (current-column) wdired-col-perm)))) + (if (eq (char-after (point)) ?-) + (setq new-bit + (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r" + (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w" + "x")))) + (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit) + (put-text-property 0 1 'read-only t new-bit) + (insert new-bit) + (delete-char 1) + (put-text-property pos-prop (1- pos-prop) 'perm-changed t))) + +(defun wdired-mouse-toggle-bit (event) + "Toggle the permission bit that was left clicked." + (interactive "e") + (mouse-set-point event) + (wdired-toggle-bit)) + +;; Allowed chars for 4000 bit are Ss in position 3 +;; Allowed chars for 2000 bit are Ssl in position 6 +;; Allowed chars for 1000 bit are Tt in position 9 +(defun wdired-perms-to-number (perms) + (let ((nperm 0777)) + (if (= (elt perms 1) ?-) (setq nperm (- nperm 400))) + (if (= (elt perms 2) ?-) (setq nperm (- nperm 200))) + (let ((p-bit (elt perms 3))) + (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100))) + (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000)))) + (if (= (elt perms 4) ?-) (setq nperm (- nperm 40))) + (if (= (elt perms 5) ?-) (setq nperm (- nperm 20))) + (let ((p-bit (elt perms 6))) + (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10))) + (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000)))) + (if (= (elt perms 7) ?-) (setq nperm (- nperm 4))) + (if (= (elt perms 8) ?-) (setq nperm (- nperm 2))) + (let ((p-bit (elt perms 9))) + (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1))) + (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000)))) + nperm)) + +;; Perform the changes in the permissions of the files that have +;; changed. +(defun wdired-do-perm-changes () + (let ((changes nil) + (errors 0) + (prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced) + 'old-perm 'perm-changed)) + filename perms-ori perms-new perm-tmp) + (goto-char (next-single-property-change (point-min) prop-wanted + nil (point-max))) + (while (not (eobp)) + (setq perms-ori (get-text-property (point) 'old-perm)) + (setq perms-new (buffer-substring-no-properties + (point) (next-single-property-change (point) 'end-perm))) + (if (not (equal perms-ori perms-new)) + (progn + (setq changes t) + (setq filename (wdired-get-filename nil t)) + (if (= (length perms-new) 10) + (progn + (setq perm-tmp + (int-to-string (wdired-perms-to-number perms-new))) + (if (not (equal 0 (dired-call-process dired-chmod-program + t perm-tmp filename))) + (progn + (setq errors (1+ errors)) + (dired-log (concat dired-chmod-program " " perm-tmp + " `" filename "' failed\n\n"))))) + (setq errors (1+ errors)) + (dired-log (concat "Cannot parse permission `" perms-new + "' for file `" filename "'\n\n"))))) + (goto-char (next-single-property-change (1+ (point)) prop-wanted + nil (point-max)))) + (cons changes errors))) + +(provide 'wdired) + +;; arch-tag: bc00902e-526f-4305-bc7f-8862a559184f +;;; wdired.el ends here
--- a/src/ChangeLog Fri Apr 23 14:44:11 2004 +0000 +++ b/src/ChangeLog Tue Apr 27 15:53:30 2004 +0000 @@ -1,3 +1,64 @@ +2004-04-27 Kim F. Storm <storm@cua.dk> + + * xdisp.c (x_produce_glyphs): Fix last change; handle newline in + header line strings. + + * dispextern.h (struct it): New member use_default_face. + + * xdisp.c (Qline_height): New variable. + (syms_of_xdisp): Intern and staticpro it. + (append_space_for_newline): Partially undo 2004-04-25 change; + add default_face_p arg, and restore callers. + Clear it->use_default_face after use. + (x_produce_glyphs): Set default font for ascii char if + it->use_default_font is set. Change line-spacing property to set + just extra line spacing. Handle new line-height property. + +2004-04-26 Andreas Schwab <schwab@suse.de> + + * print.c (print_object): Print non-ascii characters in bool + vector representation as octal escapes. + + * lisp.h (BOOL_VECTOR_BITS_PER_CHAR): Define. + * print.c (print_object): Use it instead of BITS_PER_CHAR for + bool vectors. + * lread.c (read1): Likewise. + * alloc.c (Fmake_bool_vector): Likewise. + * data.c (Faref, Faset): Likewise. + * fns.c (Fcopy_sequence, concat, internal_equal, Ffillarray) + (mapcar1): Likewise. + +2004-04-26 Steven Tamm <tamm@Steven-Tamms-Computer.local> + + * lread.c (init_lread): Fixing typo HAVE_CARBON test logic + +2004-04-26 Miles Bader <miles@gnu.org> + + * lisp.h (CYCLE_CHECK): Macro moved from xfaces.c. + +2004-04-26 Juanma Barranquero <lektu@terra.es> + + * buffer.c (Fpop_to_buffer): Fix docstring. + +2004-04-26 Steven Tamm <steventamm@mac.com> + + * lread.c (init_lread): Don't display missing lisp directory + warnings with Carbon Emacs because self-contained bundled Emacs + may be built without correct installation path. + +2004-04-25 Kim F. Storm <storm@cua.dk> + + * macterm.c (x_draw_hollow_cursor): Fix height of box for narrow lines. + + * xterm.c (x_draw_hollow_cursor): Fix height of box for narrow lines. + + * xdisp.c (append_space_for_newline): Rename from append_space. + Remove DEFAULT_FACE_P arg; always use current face. Callers changed. + (x_produce_glyphs): Handle line-spacing property on newline char. + If value is t, adjust ascent and descent to fit current row height. + If value is an integer or float, set extra_line_spacing to integer + value, or to float value x current line height. + 2004-04-23 Kenichi Handa <handa@m17n.org> * fontset.c (Finternal_char_font): If POSITION is nil, return @@ -37,7 +98,7 @@ * lisp.h (pos_visible_p): Fix prototype. - * macterm.c (x_draw_relief_rect): Add top_p and bot_p args. + * macterm.c (x_draw_relief_rect): Add top_p and bot_p args. (x_draw_glyph_string_box): Fix call to x_draw_relief_rect. (x_draw_image_foreground, x_draw_image_relief) (x_draw_image_foreground_1, x_draw_image_glyph_string): @@ -8334,12 +8395,11 @@ 2002-07-19 Juanma Barranquero <lektu@terra.es> - * fileio.c (Ffile_name_as_directory): Fix argument name in docstring. - (file_name_as_directory): Use literal '/' instead of DIRECTORY_SEP. - * xdisp.c (syms_of_xdisp): Remove redundant deprecation info. * fileio.c (syms_of_fileio): Likewise. + (Ffile_name_as_directory): Fix argument name in docstring. + (file_name_as_directory): Use literal '/' instead of DIRECTORY_SEP. 2002-07-18 Richard M. Stallman <rms@gnu.org> @@ -11989,9 +12049,9 @@ * abbrev.c (Fexpand_abbrev): Use Frun_hooks instead of Vrun_hooks. - * buffer.c (Fkill_buffer): Use Frun_hooks, not Vrun_hooks. - - * print.c (temp_output_buffer_setup): Use Frun_hooks, not Vrun_hooks. + * buffer.c (Fkill_buffer): Likewise. + + * print.c (temp_output_buffer_setup): Likewise. 2001-11-25 Stefan Monnier <monnier@cs.yale.edu>
--- a/src/alloc.c Fri Apr 23 14:44:11 2004 +0000 +++ b/src/alloc.c Tue Apr 27 15:53:30 2004 +0000 @@ -1950,10 +1950,11 @@ CHECK_NATNUM (length); - bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR; + bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR; length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value; - length_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) / BITS_PER_CHAR); + length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR); /* We must allocate one more elements than LENGTH_IN_ELTS for the slot `size' of the struct Lisp_Bool_Vector. */ @@ -1970,9 +1971,9 @@ p->data[i] = real_init; /* Clear the extraneous bits in the last byte. */ - if (XINT (length) != length_in_chars * BITS_PER_CHAR) + if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR) XBOOL_VECTOR (val)->data[length_in_chars - 1] - &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1; + &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; }
--- a/src/buffer.c Fri Apr 23 14:44:11 2004 +0000 +++ b/src/buffer.c Tue Apr 27 15:53:30 2004 +0000 @@ -1683,7 +1683,7 @@ doc: /* Select buffer BUFFER in some window, preferably a different one. If BUFFER is nil, then some other buffer is chosen. If `pop-up-windows' is non-nil, windows can be split to do this. -If optional second arg OTHER-WINDOW is nil, insist on finding another +If optional second arg OTHER-WINDOW is non-nil, insist on finding another window even if BUFFER is already visible in the selected window, and ignore `same-window-regexps' and `same-window-buffer-names'. This uses the function `display-buffer' as a subroutine; see the documentation
--- a/src/data.c Fri Apr 23 14:44:11 2004 +0000 +++ b/src/data.c Tue Apr 27 15:53:30 2004 +0000 @@ -1946,8 +1946,8 @@ if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) args_out_of_range (array, idx); - val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR]; - return (val & (1 << (idxval % BITS_PER_CHAR)) ? Qt : Qnil); + val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR]; + return (val & (1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)) ? Qt : Qnil); } else if (CHAR_TABLE_P (array)) { @@ -2074,13 +2074,13 @@ if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) args_out_of_range (array, idx); - val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR]; + val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR]; if (! NILP (newelt)) - val |= 1 << (idxval % BITS_PER_CHAR); + val |= 1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR); else - val &= ~(1 << (idxval % BITS_PER_CHAR)); - XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR] = val; + val &= ~(1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)); + XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR] = val; } else if (CHAR_TABLE_P (array)) {
--- a/src/dispextern.h Fri Apr 23 14:44:11 2004 +0000 +++ b/src/dispextern.h Tue Apr 27 15:53:30 2004 +0000 @@ -1920,9 +1920,12 @@ unsigned face_before_selective_p : 1; /* If 1, adjust current glyph so it does not increase current row - descent/ascent. */ + descent/ascent (line-height property). Reset after this glyph. */ unsigned constrain_row_ascent_descent_p : 1; + /* If 1, show current glyph in default face. Reset after this glyph. */ + unsigned use_default_face : 1; + /* The ID of the default face to use. One of DEFAULT_FACE_ID, MODE_LINE_FACE_ID, etc, depending on what we are displaying. */ int base_face_id;
--- a/src/fns.c Fri Apr 23 14:44:11 2004 +0000 +++ b/src/fns.c Tue Apr 27 15:53:30 2004 +0000 @@ -1,5 +1,5 @@ /* Random utility Lisp functions. - Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 2003 + Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 03, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -513,7 +513,8 @@ { Lisp_Object val; int size_in_chars - = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; + = ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR); val = Fmake_bool_vector (Flength (arg), Qnil); bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data, @@ -783,8 +784,8 @@ else if (BOOL_VECTOR_P (this)) { int byte; - byte = XBOOL_VECTOR (this)->data[thisindex / BITS_PER_CHAR]; - if (byte & (1 << (thisindex % BITS_PER_CHAR))) + byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR]; + if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR))) elt = Qt; else elt = Qnil; @@ -2245,7 +2246,8 @@ if (BOOL_VECTOR_P (o1)) { int size_in_chars - = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; + = ((XBOOL_VECTOR (o1)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR); if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size) return 0; @@ -2356,7 +2358,8 @@ { register unsigned char *p = XBOOL_VECTOR (array)->data; int size_in_chars - = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; + = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR); charval = (! NILP (item) ? -1 : 0); for (index = 0; index < size_in_chars - 1; index++) @@ -2364,8 +2367,8 @@ if (index < size_in_chars) { /* Mask out bits beyond the vector size. */ - if (XBOOL_VECTOR (array)->size % BITS_PER_CHAR) - charval &= (1 << (XBOOL_VECTOR (array)->size % BITS_PER_CHAR)) - 1; + if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR) + charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1; p[index] = charval; } } @@ -2958,8 +2961,8 @@ for (i = 0; i < leni; i++) { int byte; - byte = XBOOL_VECTOR (seq)->data[i / BITS_PER_CHAR]; - if (byte & (1 << (i % BITS_PER_CHAR))) + byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR]; + if (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR))) dummy = Qt; else dummy = Qnil;
--- a/src/lisp.h Fri Apr 23 14:44:11 2004 +0000 +++ b/src/lisp.h Tue Apr 27 15:53:30 2004 +0000 @@ -278,6 +278,10 @@ /* For convenience, we also store the number of elements in these bits. */ #define PSEUDOVECTOR_SIZE_MASK 0x1ff + +/* Number of bits to put in each character in the internal representation + of bool vectors. This should not vary across implementations. */ +#define BOOL_VECTOR_BITS_PER_CHAR 8 /***** Select the tagging scheme. *****/ @@ -3187,6 +3191,32 @@ ? make_float (val) \ : make_number ((EMACS_INT)(val))) + +/* Checks the `cycle check' variable CHECK to see if it indicates that + EL is part of a cycle; CHECK must be either Qnil or a value returned + by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of + elements after which a cycle might be suspected; after that many + elements, this macro begins consing in order to keep more precise + track of elements. + + Returns nil if a cycle was detected, otherwise a new value for CHECK + that includes EL. + + CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so + the caller should make sure that's ok. */ + +#define CYCLE_CHECK(check, el, suspicious) \ + (NILP (check) \ + ? make_number (0) \ + : (INTEGERP (check) \ + ? (XFASTINT (check) < (suspicious) \ + ? make_number (XFASTINT (check) + 1) \ + : Fcons (el, Qnil)) \ + : (!NILP (Fmemq ((el), (check))) \ + ? Qnil \ + : Fcons ((el), (check))))) + + #endif /* EMACS_LISP_H */ /* arch-tag: 9b2ed020-70eb-47ac-94ee-e1c2a5107d5e
--- a/src/lread.c Fri Apr 23 14:44:11 2004 +0000 +++ b/src/lread.c Tue Apr 27 15:53:30 2004 +0000 @@ -1994,8 +1994,9 @@ if (c == '"') { Lisp_Object tmp, val; - int size_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) - / BITS_PER_CHAR); + int size_in_chars + = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR); UNREAD (c); tmp = read1 (readcharfun, pch, first_in_list); @@ -2004,7 +2005,7 @@ when the number of bits was a multiple of 8. Accept such input in case it came from an old version. */ && ! (XFASTINT (length) - == (SCHARS (tmp) - 1) * BITS_PER_CHAR)) + == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)) Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), Qnil)); @@ -2012,9 +2013,9 @@ bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data, size_in_chars); /* Clear the extraneous bits in the last byte. */ - if (XINT (length) != size_in_chars * BITS_PER_CHAR) + if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR) XBOOL_VECTOR (val)->data[size_in_chars - 1] - &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1; + &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; } Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), @@ -3677,11 +3678,15 @@ } #endif -#ifndef WINDOWSNT +#if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON)))) /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is almost never correct, thereby causing a warning to be printed out that confuses users. Since PATH_LOADSEARCH is always overridden by the - EMACSLOADPATH environment variable below, disable the warning on NT. */ + EMACSLOADPATH environment variable below, disable the warning on NT. + Also, when using the "self-contained" option for Carbon Emacs for MacOSX, + the "standard" paths may not exist and would be overridden by + EMACSLOADPATH as on NT. Since this depends on how the executable + was build and packaged, turn off the warnings in general */ /* Warn if dirs in the *standard* path don't exist. */ if (!turn_off_warning) @@ -3703,7 +3708,7 @@ } } } -#endif /* WINDOWSNT */ +#endif /* !(WINDOWSNT || HAVE_CARBON) */ /* If the EMACSLOADPATH environment variable is set, use its value. This doesn't apply if we're dumping. */
--- a/src/macterm.c Fri Apr 23 14:44:11 2004 +0000 +++ b/src/macterm.c Tue Apr 27 15:53:30 2004 +0000 @@ -4665,7 +4665,8 @@ /* Compute the proper height and ascent of the rectangle, based on the actual glyph. Using the full height of the row looks bad when there are tall images on that row. */ - h = max (FRAME_LINE_HEIGHT (f), cursor_glyph->ascent + cursor_glyph->descent); + h = max (min (FRAME_LINE_HEIGHT (f), row->height), + cursor_glyph->ascent + cursor_glyph->descent); if (h < row->height) y += row->ascent /* - w->phys_cursor_ascent */ + cursor_glyph->descent - h; h--;
--- a/src/print.c Fri Apr 23 14:44:11 2004 +0000 +++ b/src/print.c Tue Apr 27 15:53:30 2004 +0000 @@ -1,5 +1,5 @@ /* Lisp object printing and output streams. - Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 2003 + Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 03, 2004 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -1783,7 +1783,8 @@ register unsigned char c; struct gcpro gcpro1; int size_in_chars - = (XBOOL_VECTOR (obj)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; + = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR); GCPRO1 (obj); @@ -1814,6 +1815,14 @@ PRINTCHAR ('\\'); PRINTCHAR ('f'); } + else if (c > '\177') + { + /* Use octal escapes to avoid encoding issues. */ + PRINTCHAR ('\\'); + PRINTCHAR ('0' + ((c >> 6) & 3)); + PRINTCHAR ('0' + ((c >> 3) & 7)); + PRINTCHAR ('0' + (c & 7)); + } else { if (c == '\"' || c == '\\')
--- a/src/xdisp.c Fri Apr 23 14:44:11 2004 +0000 +++ b/src/xdisp.c Tue Apr 27 15:53:30 2004 +0000 @@ -304,6 +304,7 @@ Lisp_Object Qslice; Lisp_Object Qcenter; Lisp_Object Qmargin, Qpointer; +Lisp_Object Qline_height; extern Lisp_Object Qheight; extern Lisp_Object QCwidth, QCheight, QCascent; extern Lisp_Object Qscroll_bar; @@ -846,7 +847,7 @@ static struct glyph_row *get_overlay_arrow_glyph_row P_ ((struct window *, Lisp_Object)); static void extend_face_to_end_of_line P_ ((struct it *)); -static int append_space P_ ((struct it *, int)); +static int append_space_for_newline P_ ((struct it *, int)); static int make_cursor_line_fully_visible P_ ((struct window *, int)); static int try_scrolling P_ ((Lisp_Object, int, EMACS_INT, EMACS_INT, int, int)); static int try_cursor_movement P_ ((Lisp_Object, struct text_pos, int *)); @@ -14144,8 +14145,7 @@ /* Append one space to the glyph row of iterator IT if doing a - window-based redisplay. DEFAULT_FACE_P non-zero means let the - space have the default face, otherwise let it have the same face as + window-based redisplay. The space has the same face as IT->face_id. Value is non-zero if a space was added. This function is called to make sure that there is always one glyph @@ -14157,7 +14157,7 @@ end of the line if the row ends in italic text. */ static int -append_space (it, default_face_p) +append_space_for_newline (it, default_face_p) struct it *it; int default_face_p; { @@ -14171,7 +14171,7 @@ /* Save some values that must not be changed. Must save IT->c and IT->len because otherwise ITERATOR_AT_END_P wouldn't work anymore after - append_space has been called. */ + append_space_for_newline has been called. */ enum display_element_type saved_what = it->what; int saved_c = it->c, saved_len = it->len; int saved_x = it->current_x; @@ -14196,11 +14196,9 @@ face = FACE_FROM_ID (it->f, it->face_id); it->face_id = FACE_FOR_CHAR (it->f, face, 0); - if (it->max_ascent > 0 || it->max_descent > 0) - it->constrain_row_ascent_descent_p = 1; - PRODUCE_GLYPHS (it); + it->use_default_face = 0; it->constrain_row_ascent_descent_p = 0; it->current_x = saved_x; it->object = saved_object; @@ -14483,7 +14481,7 @@ row->exact_window_width_line_p = 1; else #endif /* HAVE_WINDOW_SYSTEM */ - if ((append_space (it, 1) && row->used[TEXT_AREA] == 1) + if ((append_space_for_newline (it, 1) && row->used[TEXT_AREA] == 1) || row->used[TEXT_AREA] == 0) { row->glyphs[TEXT_AREA]->charpos = -1; @@ -14725,7 +14723,7 @@ /* Add a space at the end of the line that is used to display the cursor there. */ if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it)) - append_space (it, 0); + append_space_for_newline (it, 0); #endif /* HAVE_WINDOW_SYSTEM */ /* Extend the face to the end of the line. */ @@ -18514,6 +18512,8 @@ x_produce_glyphs (it) struct it *it; { + int extra_line_spacing = it->extra_line_spacing; + it->glyph_not_available_p = 0; if (it->what == IT_CHARACTER) @@ -18589,6 +18589,12 @@ it->nglyphs = 1; + if (it->use_default_face) + { + font = FRAME_FONT (it->f); + boff = FRAME_BASELINE_OFFSET (it->f); + } + pcm = FRAME_RIF (it->f)->per_char_metric (font, &char2b, FONT_TYPE_FOR_UNIBYTE (font, it->char_to_display)); @@ -18612,18 +18618,19 @@ if (it->constrain_row_ascent_descent_p) { if (it->descent > it->max_descent) - { - it->ascent += it->descent - it->max_descent; - it->descent = it->max_descent; - } - if (it->ascent> it->max_ascent) - { - it->descent = min (it->max_descent, it->descent + it->ascent - it->max_ascent); - it->ascent = it->max_ascent; - } - it->phys_ascent = min (it->phys_ascent, it->ascent); - it->phys_descent = min (it->phys_descent, it->descent); - } + { + it->ascent += it->descent - it->max_descent; + it->descent = it->max_descent; + } + if (it->ascent > it->max_ascent) + { + it->descent = min (it->max_descent, it->descent + it->ascent - it->max_ascent); + it->ascent = it->max_ascent; + } + it->phys_ascent = min (it->phys_ascent, it->ascent); + it->phys_descent = min (it->phys_descent, it->descent); + extra_line_spacing = 0; + } /* If this is a space inside a region of text with `space-width' property, change its width. */ @@ -18695,32 +18702,68 @@ But if previous part of the line set a height, don't increase that height */ + Lisp_Object lsp, lh; + it->pixel_width = 0; it->nglyphs = 0; + lh = Fget_text_property (IT_CHARPOS (*it), Qline_height, it->object); + + if (EQ (lh, Qt)) + { + it->use_default_face = 1; + font = FRAME_FONT (it->f); + boff = FRAME_BASELINE_OFFSET (it->f); + font_info = NULL; + } + it->ascent = FONT_BASE (font) + boff; it->descent = FONT_DESCENT (font) - boff; - if (it->max_ascent > 0 || it->max_descent > 0) - { - it->ascent = it->descent = 0; - } - else - { - it->ascent = FONT_BASE (font) + boff; - it->descent = FONT_DESCENT (font) - boff; - } - - it->phys_ascent = it->ascent; - it->phys_descent = it->descent; - - if ((it->max_ascent > 0 || it->max_descent > 0) - && face->box != FACE_NO_BOX - && face->box_line_width > 0) - { - it->ascent += face->box_line_width; - it->descent += face->box_line_width; - } + if (EQ (lh, make_number (0))) + { + if (it->descent > it->max_descent) + { + it->ascent += it->descent - it->max_descent; + it->descent = it->max_descent; + } + if (it->ascent > it->max_ascent) + { + it->descent = min (it->max_descent, it->descent + it->ascent - it->max_ascent); + it->ascent = it->max_ascent; + } + it->phys_ascent = min (it->phys_ascent, it->ascent); + it->phys_descent = min (it->phys_descent, it->descent); + it->constrain_row_ascent_descent_p = 1; + extra_line_spacing = 0; + } + else + { + int explicit_height = -1; + it->phys_ascent = it->ascent; + it->phys_descent = it->descent; + + if ((it->max_ascent > 0 || it->max_descent > 0) + && face->box != FACE_NO_BOX + && face->box_line_width > 0) + { + it->ascent += face->box_line_width; + it->descent += face->box_line_width; + } + if (INTEGERP (lh)) + explicit_height = XINT (lh); + else if (FLOATP (lh)) + explicit_height = (it->phys_ascent + it->phys_descent) * XFLOAT_DATA (lh); + + if (explicit_height > it->ascent + it->descent) + it->ascent = explicit_height - it->descent; + } + + lsp = Fget_text_property (IT_CHARPOS (*it), Qline_spacing, it->object); + if (INTEGERP (lsp)) + extra_line_spacing = XINT (lsp); + else if (FLOATP (lsp)) + extra_line_spacing = (it->phys_ascent + it->phys_descent) * XFLOAT_DATA (lsp); } else if (it->char_to_display == '\t') { @@ -19097,7 +19140,7 @@ if (it->area == TEXT_AREA) it->current_x += it->pixel_width; - it->descent += it->extra_line_spacing; + it->descent += extra_line_spacing; it->max_ascent = max (it->max_ascent, it->ascent); it->max_descent = max (it->max_descent, it->descent); @@ -21743,6 +21786,8 @@ staticpro (&Qright_margin); Qcenter = intern ("center"); staticpro (&Qcenter); + Qline_height = intern ("line-height"); + staticpro (&Qline_height); QCalign_to = intern (":align-to"); staticpro (&QCalign_to); QCrelative_width = intern (":relative-width");
--- a/src/xfaces.c Fri Apr 23 14:44:11 2004 +0000 +++ b/src/xfaces.c Tue Apr 27 15:53:30 2004 +0000 @@ -3482,32 +3482,6 @@ to[LFACE_INHERIT_INDEX] = Qnil; } - -/* Checks the `cycle check' variable CHECK to see if it indicates that - EL is part of a cycle; CHECK must be either Qnil or a value returned - by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of - elements after which a cycle might be suspected; after that many - elements, this macro begins consing in order to keep more precise - track of elements. - - Returns nil if a cycle was detected, otherwise a new value for CHECK - that includes EL. - - CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so - the caller should make sure that's ok. */ - -#define CYCLE_CHECK(check, el, suspicious) \ - (NILP (check) \ - ? make_number (0) \ - : (INTEGERP (check) \ - ? (XFASTINT (check) < (suspicious) \ - ? make_number (XFASTINT (check) + 1) \ - : Fcons (el, Qnil)) \ - : (!NILP (Fmemq ((el), (check))) \ - ? Qnil \ - : Fcons ((el), (check))))) - - /* Merge face attributes from the face on frame F whose name is INHERITS, into the vector of face attributes TO; INHERITS may also be a list of face names, in which case they are applied in order.
--- a/src/xterm.c Fri Apr 23 14:44:11 2004 +0000 +++ b/src/xterm.c Tue Apr 27 15:53:30 2004 +0000 @@ -7261,7 +7261,8 @@ /* Compute the proper height and ascent of the rectangle, based on the actual glyph. Using the full height of the row looks bad when there are tall images on that row. */ - h = max (FRAME_LINE_HEIGHT (f), cursor_glyph->ascent + cursor_glyph->descent); + h = max (min (FRAME_LINE_HEIGHT (f), row->height), + cursor_glyph->ascent + cursor_glyph->descent); if (h < row->height) y += row->ascent /* - w->phys_cursor_ascent */ + cursor_glyph->descent - h; h--;