aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaroly Lorentey2004-04-27 15:53:30 +0000
committerKaroly Lorentey2004-04-27 15:53:30 +0000
commit6c8caecfb9c96879b8ea6f1e08314408be40a832 (patch)
treecec3e345d246fe9b789786da588c5c6334215679
parentced7ed5611e2a6e60a5ac7a97e165545843d0fa9 (diff)
parentc4c07982c1a6b3ddd9339ecdb9af1876f70d8792 (diff)
downloademacs-6c8caecfb9c96879b8ea6f1e08314408be40a832.tar.gz
emacs-6c8caecfb9c96879b8ea6f1e08314408be40a832.zip
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
-rw-r--r--ChangeLog4
-rw-r--r--MAINTAINERS6
-rwxr-xr-xautogen.sh2
-rw-r--r--etc/NEWS38
-rw-r--r--etc/compilation.txt1
-rw-r--r--lib-src/ChangeLog6
-rw-r--r--lib-src/make-docfile.c16
-rw-r--r--lisp/ChangeLog159
-rw-r--r--lisp/comint.el3
-rw-r--r--lisp/desktop.el65
-rw-r--r--lisp/diff.el2
-rw-r--r--lisp/dired.el4
-rw-r--r--lisp/emacs-lisp/checkdoc.el49
-rw-r--r--lisp/emacs-lisp/rx.el421
-rw-r--r--lisp/help.el68
-rw-r--r--lisp/ielm.el85
-rw-r--r--lisp/image.el2
-rw-r--r--lisp/info-look.el19
-rw-r--r--lisp/info.el127
-rw-r--r--lisp/log-view.el6
-rw-r--r--lisp/mail/rmail.el26
-rw-r--r--lisp/mail/sendmail.el7
-rw-r--r--lisp/mh-e/ChangeLog12
-rw-r--r--lisp/mh-e/mh-e.el2
-rw-r--r--lisp/paren.el5
-rw-r--r--lisp/pcomplete.el39
-rw-r--r--lisp/progmodes/compile.el142
-rw-r--r--lisp/progmodes/gud.el2
-rw-r--r--lisp/progmodes/sh-script.el2
-rw-r--r--lisp/simple.el7
-rw-r--r--lisp/textmodes/picture.el10
-rw-r--r--lisp/vc-hooks.el8
-rw-r--r--lisp/vc.el6
-rw-r--r--lisp/wdired.el872
-rw-r--r--src/ChangeLog72
-rw-r--r--src/alloc.c9
-rw-r--r--src/buffer.c2
-rw-r--r--src/data.c12
-rw-r--r--src/dispextern.h5
-rw-r--r--src/fns.c23
-rw-r--r--src/lisp.h30
-rw-r--r--src/lread.c21
-rw-r--r--src/macterm.c3
-rw-r--r--src/print.c13
-rw-r--r--src/xdisp.c117
-rw-r--r--src/xfaces.c26
-rw-r--r--src/xterm.c3
47 files changed, 2027 insertions, 532 deletions
diff --git a/ChangeLog b/ChangeLog
index a97a1fa2c26..ae0e09e08da 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
12004-04-24 Thien-Thi Nguyen <ttn@gnu.org>
2
3 * autogen.sh: Update filename in "please read" message.
4
12004-04-17 Richard M. Stallman <rms@gnu.org> 52004-04-17 Richard M. Stallman <rms@gnu.org>
2 6
3 * INSTALL: Move the info about site-lisp dirs, 7 * INSTALL: Move the info about site-lisp dirs,
diff --git a/MAINTAINERS b/MAINTAINERS
index c9e16c9c9a0..d1340adc070 100644
--- a/MAINTAINERS
+++ b/MAINTAINERS
@@ -19,9 +19,6 @@ maintainer has been found so far.
19Richard Stallman 19Richard Stallman
20 ??? 20 ???
21 21
22Andrew Choi
23 MacOS
24
25Jason Rumney 22Jason Rumney
26 W32 23 W32
27 24
@@ -73,6 +70,9 @@ Miles Bader
732. 702.
74============================================================================== 71==============================================================================
75 72
73Steven Tamm
74 MacOS
75
76Eli Zaretskii 76Eli Zaretskii
77 man/* 77 man/*
78 lispref/* 78 lispref/*
diff --git a/autogen.sh b/autogen.sh
index 89d6b9c4378..0fe7ef32fc2 100755
--- a/autogen.sh
+++ b/autogen.sh
@@ -1,6 +1,6 @@
1#!/bin/sh 1#!/bin/sh
2 2
3echo "Please read INSTALL-CVS for instructions on how to build Emacs from CVS." 3echo "Please read INSTALL.CVS for instructions on how to build Emacs from CVS."
4 4
5# Exit with failure, since people may have generic build scripts that 5# Exit with failure, since people may have generic build scripts that
6# try things like "autogen.sh && ./configure && make". 6# try things like "autogen.sh && ./configure && make".
diff --git a/etc/NEWS b/etc/NEWS
index 9320ae29174..8ca9bfacd4d 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -4,6 +4,8 @@ See the end for copying conditions.
4 4
5Please send Emacs bug reports to bug-gnu-emacs@gnu.org. 5Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
6For older news, see the file ONEWS 6For older news, see the file ONEWS
7You can narrow news to the specific version by calling
8`view-emacs-news' with a prefix argument or by typing C-u C-h C-n.
7 9
8Temporary note: 10Temporary note:
9 +++ indicates that the appropriate manual has already been updated. 11 +++ indicates that the appropriate manual has already been updated.
@@ -88,6 +90,10 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types.
88 90
89* Changes in Emacs 21.4 91* Changes in Emacs 21.4
90 92
93---
94** The IELM prompt is now, by default, read-only. This can be
95controlled with the new user option `ielm-prompt-read-only'.
96
91** You can now use next-error (C-x `) and previous-error to advance to 97** You can now use next-error (C-x `) and previous-error to advance to
92the next/previous matching line found by M-x occur. 98the next/previous matching line found by M-x occur.
93 99
@@ -1984,9 +1990,35 @@ specify image slice (X Y WIDTH HEIGHT).
1984*** New function insert-sliced-image inserts a given image as a 1990*** New function insert-sliced-image inserts a given image as a
1985specified number of evenly sized slices (rows x columns). 1991specified number of evenly sized slices (rows x columns).
1986 1992
1987*** Trailing newlines no longer contribute to the height of a display 1993** New line-height and line-spacing properties for newline characters
1988row; instead the height of the newline glyph is reduced. This allows 1994
1989sliced images to use a height less than the default line height. 1995A newline may now have line-height and line-spacing text properties that
1996control the height of the corresponding display row.
1997
1998If the line-height property value is 0, the newline does not
1999contribute to the height of the display row; instead the height of the
2000newline glyph is reduced. This can be used to tile small images or
2001image slices without adding blank areas between the images.
2002
2003If the line-height property value is a positive integer, the value
2004specifies the minimum line height in pixels. If necessary, the line
2005height it increased by increasing the line's ascent.
2006
2007If the line-height property value is a float, the minimum line height
2008is calculated by multiplying the height of the current face font by
2009the given value.
2010
2011If the line-height property value is t, the minimum line height is
2012the height of the default frame font.
2013
2014If the line-spacing property value is an integer, the value is used as
2015additional space to put after the display line; this overrides the
2016default frame line-spacing and any buffer local value of the
2017line-spacing variable.
2018
2019If the line-spacing property value is a float, the value is multiplied
2020by the current height of the display row to determine the additional
2021space to put after the display line.
1990 2022
1991** Enhancements to stretch display properties 2023** Enhancements to stretch display properties
1992 2024
diff --git a/etc/compilation.txt b/etc/compilation.txt
index 6420580fe6d..3baebe6aaf3 100644
--- a/etc/compilation.txt
+++ b/etc/compilation.txt
@@ -120,6 +120,7 @@ foo.c(5:5) : error EDC0350: Syntax error.
120symbol: irix 120symbol: irix
121 121
122ccom: Error: foo.c, line 2: syntax error 122ccom: Error: foo.c, line 2: syntax error
123cc: Severe: /src/Python-2.3.3/Modules/_curses_panel.c, line 17: Cannot find file <panel.h> ...
123cc: Info: foo.c, line 27: ... 124cc: Info: foo.c, line 27: ...
124cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ... 125cfe: Warning 712: foo.c, line 2: illegal combination of pointer and ...
125cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ... 126cfe: Warning 600: xfe.c: 170: Not in a conditional directive while ...
diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog
index eaf07239901..e2fcc6cc939 100644
--- a/lib-src/ChangeLog
+++ b/lib-src/ChangeLog
@@ -1,3 +1,9 @@
12004-04-26 Eli Zaretskii <eliz@gnu.org>
2
3 * make-docfile.c (IS_DIRECTORY_SEP): New macro.
4 (put_filename): Remove unused variable len. Use IS_DIRECTORY_SEP
5 instead of a literal '/'.
6
12004-04-23 Juanma Barranquero <lektu@terra.es> 72004-04-23 Juanma Barranquero <lektu@terra.es>
2 8
3 * makefile.w32-in: Add "-*- makefile -*-" mode tag. 9 * makefile.w32-in: Add "-*- makefile -*-" mode tag.
diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c
index ba73f5800a7..1c0bc559225 100644
--- a/lib-src/make-docfile.c
+++ b/lib-src/make-docfile.c
@@ -60,6 +60,10 @@ Boston, MA 02111-1307, USA. */
60#define READ_BINARY "r" 60#define READ_BINARY "r"
61#endif /* not DOS_NT */ 61#endif /* not DOS_NT */
62 62
63#ifndef IS_DIRECTORY_SEP
64#define IS_DIRECTORY_SEP(_c_) ((_c_) == '/')
65#endif
66
63int scan_file (); 67int scan_file ();
64int scan_lisp_file (); 68int scan_lisp_file ();
65int scan_c_file (); 69int scan_c_file ();
@@ -183,11 +187,13 @@ void
183put_filename (filename) 187put_filename (filename)
184 char *filename; 188 char *filename;
185{ 189{
186 char *tmp = filename; 190 char *tmp;
187 int len; 191
188 192 for (tmp = filename; *tmp; tmp++)
189 while ((tmp = index (filename, '/'))) 193 {
190 filename = tmp + 1; 194 if (IS_DIRECTORY_SEP(*tmp))
195 filename = tmp + 1;
196 }
191 197
192 putc (037, outfile); 198 putc (037, outfile);
193 putc ('S', outfile); 199 putc ('S', outfile);
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 9d0215df2e4..5a3b646bc72 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,160 @@
12004-04-27 Juri Linkov <juri@jurta.org>
2
3 * help.el (view-emacs-news): With argument, display info for the
4 selected version by finding it among different NEWS files, and
5 narrowing the buffer to the selected version.
6
7 * info.el: Add *info*<[0-9]+> to same-window-regexps instead of
8 same-window-buffer-names.
9 (info): New arg `buffer'. Use it. Doc fix. Read file name for
10 non-numeric prefix argument, append the number to the buffer name
11 for numeric prefix argument.
12 (info-other-window): Bind same-window-regexps to nil.
13 (Info-reference-name): Rename to Info-point-loc.
14 (Info-find-node-2): Call forward-line for numeric Info-point-loc,
15 and Info-find-index-name for stringy Info-point-loc.
16 (Info-extract-menu-node-name): New arg `index-node'. Use regexp
17 without middle `.', but with final `.' and optional line number
18 for it. Set Info-point-loc for index nodes.
19 (Info-index): Remove middle `.' from index entry regexp.
20 Modify line number regexp.
21 (Info-index-next): Decrement line number.
22 (info-apropos): Remove middle `.' from index entry regexp.
23 Add optional line number regexp at the end. Add matched value
24 for line number to the result list and insert it to the buffer.
25 Replace match-string by match-string-no-properties.
26 Reorder result list.
27 (Info-fontify-node): Hide index line numbers.
28 (Info-goto-node): Replace "\\s *\\'" by "\\s +\\'" to not trim
29 empty matches.
30 (Info-follow-reference): Use `str' instead of
31 Info-following-node-name-re.
32 (Info-toc): Use full file names. Set Info-current-node to "Top".
33 (Info-fontify-node): Compare file names without directory name.
34 (Info-try-follow-nearest-node): Don't set Info-reference-name.
35 Set second arg of Info-extract-menu-node-name for index nodes.
36 (info-xref-visited): Use magenta3 instead of magenta4.
37 (Info-mode): Add info-apropos to docstring.
38
39 * log-view.el (log-view-diff): Replace interactive code "r"
40 by a list to allow to call it even if region is not active.
41
42 * paren.el (show-paren-highlight-openparen): New var.
43 (show-paren-function): Turn on openparen highlighting when
44 matching forward if show-paren-highlight-openparen is non-nil.
45
46 * simple.el (kill-ring-save): Use blink-matching-delay instead of
47 the constant value 1.
48 (completions-common-part): Expand docstring.
49
50 * textmodes/picture.el (picture-mode-map): Add arrow keys.
51
522004-04-27 Kim F. Storm <storm@cua.dk>
53
54 * image.el (insert-sliced-image): Use line-height instead of
55 line-spacing property on newline.
56
572004-04-26 Lars Hansen <larsh@math.ku.dk>
58
59 * desktop.el (desktop-buffer-misc-data-function): Rename to
60 desktop-save-buffer and change docstring.
61 (desktop-buffer-modes-to-save): Delete.
62 (desktop-save-buffer-p): Use desktop-save-buffer instead of
63 desktop-buffer-modes-to-save.
64 (desktop-save): Rename desktop-buffer-misc-data-function to
65 desktop-save-buffer and allow non-function value.
66 (desktop-missing-file-warning): Correct docstring.
67
68 * dired.el (dired-mode): Rename desktop-buffer-misc-data-function
69 to desktop-save-buffer.
70
71 * info.el (Info-mode): Rename desktop-buffer-misc-data-function to
72 desktop-save-buffer.
73
74 * mail/rmail.el (rmail-variables): Bind desktop-save-buffer to t.
75
76 * mh-e/mh-e.el (mh-folder-mode): Bind desktop-save-buffer to t.
77
782004-04-26 Eli Zaretskii <eliz@gnu.org>
79
80 * progmodes/gud.el (gud-pdb-command-name): Change default to
81 "pydb".
82
83
842004-04-25 Luc Teirlinck <teirllm@auburn.edu>
85
86 * ielm.el (ielm-prompt-read-only, ielm-prompt): Expand docstring.
87 (ielm): Only go to the end of the buffer when starting a new process.
88
892004-04-25 Juanma Barranquero <lektu@terra.es>
90
91 * ielm.el (inferior-emacs-lisp-mode): Display working buffer on the
92 mode line. Bind `inhibit-read-only' to t before modifying
93 properties of text in the buffer.
94 (ielm): Force point to the end of buffer, even when running ielm
95 from inside itself.
96
972004-04-25 Jesper Harder <harder@ifa.au.dk>
98
99 * info.el (info-apropos): Reset Info-complete-cache.
100
1012004-04-25 Daniel Pfeiffer <occitan@esperanto.org>
102
103 * progmodes/compile.el (compilation-error-regexp-alist-alist):
104 Also recognize severe Irix et al. messages.
105 (compilation-normalize-filename, compile-abbreviate-directory):
106 Delete functions.
107 (compilation-get-file-structure): New function inherits
108 functionality of the two preceding ones.
109 (compilation-internal-error-properties, compilation-fake-loc): Use
110 it so that different paths to the same file share the same
111 markers. Also optimize finding adjacent marker slightly.
112
1132004-04-25 Kim F. Storm <storm@cua.dk>
114
115 * image.el (insert-sliced-image): Add line-spacing t property
116 to newlines separating image lines.
117
1182004-04-24 Luc Teirlinck <teirllm@auburn.edu>
119
120 * comint.el (comint-delete-output): Bind inhibit-read-only to t.
121
122 * ielm.el (ielm-prompt-read-only): New user option.
123 (ielm-prompt): Expand docstring to describe new behavior.
124 (inferior-emacs-lisp-mode): Implement ielm-prompt-read-only and
125 mention it in the docstring.
126
1272004-04-24 Andreas Schwab <schwab@suse.de>
128
129 * progmodes/sh-script.el (sh-leading-keywords) <sh>: Add "!".
130
131 * diff.el (diff): Set default-directory in diff buffer.
132
1332004-04-24 Eli Zaretskii <eliz@gnu.org>
134
135 * mail/sendmail.el (mail-bury): Don't delete the frame where the
136 mail was being composed if the terminal cannot display more than
137 one frame; instead, switch to previous frame.
138
139 * mail/rmail.el (rmail-mail-new-frame): Doc fix.
140 (rmail-start-mail): Support rmail-mail-new-frame even on
141 terminals that can display only one frame at a time.
142
1432004-04-23 Juanma Barranquero <lektu@terra.es>
144
145 * ielm.el (inferior-emacs-lisp-mode): Fix docstring.
146
147 * pcomplete.el (pcomplete-opt, pcomplete-actual-arg)
148 (pcomplete-match-string, pcomplete-comint-setup, pcomplete-here)
149 (pcomplete--help, pcomplete--here): Doc fixes.
150
1512004-04-23 Andre Spiegel <spiegel@gnu.org>
152
153 * vc-hooks.el (vc-default-workfile-unchanged-p): Fix code that
154 handles wrong-number-of-arguments in backend call.
155
156 * vc.el (vc-print-log): Likewise.
157
12004-04-23 Kenichi Handa <handa@m17n.org> 1582004-04-23 Kenichi Handa <handa@m17n.org>
2 159
3 * international/mule-util.el (char-displayable-p): Simplified by 160 * international/mule-util.el (char-displayable-p): Simplified by
@@ -121,9 +278,11 @@
121 Add parameters. Pause to display error only when 278 Add parameters. Pause to display error only when
122 desktop-missing-file-warning is non-nil. 279 desktop-missing-file-warning is non-nil.
123 (dired-desktop-buffer-misc-data): Move from desktop.el. Add parameter. 280 (dired-desktop-buffer-misc-data): Move from desktop.el. Add parameter.
281 (dired-mode): Bind desktop-buffer-misc-data-function.
124 * info.el (Info-restore-desktop-buffer): Move from desktop.el. 282 * info.el (Info-restore-desktop-buffer): Move from desktop.el.
125 Add Parameters. 283 Add Parameters.
126 (Info-desktop-buffer-misc-data): Move from desktop.el. Add parameter. 284 (Info-desktop-buffer-misc-data): Move from desktop.el. Add parameter.
285 (Info-mode): Bind desktop-buffer-misc-data-function.
127 * mail/rmail.el (rmail-restore-desktop-buffer): Move from desktop.el. 286 * mail/rmail.el (rmail-restore-desktop-buffer): Move from desktop.el.
128 Add Parameters. 287 Add Parameters.
129 * mh-e/mh-e.el (mh-restore-desktop-buffer): Move from desktop.el. 288 * mh-e/mh-e.el (mh-restore-desktop-buffer): Move from desktop.el.
diff --git a/lisp/comint.el b/lisp/comint.el
index 57e785dce47..7766307f156 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -2006,7 +2006,8 @@ This function could be in the list `comint-output-filter-functions'."
2006Does not delete the prompt." 2006Does not delete the prompt."
2007 (interactive) 2007 (interactive)
2008 (let ((proc (get-buffer-process (current-buffer))) 2008 (let ((proc (get-buffer-process (current-buffer)))
2009 (replacement nil)) 2009 (replacement nil)
2010 (inhibit-read-only t))
2010 (save-excursion 2011 (save-excursion
2011 (let ((pmark (progn (goto-char (process-mark proc)) 2012 (let ((pmark (progn (goto-char (process-mark proc))
2012 (forward-line 0) 2013 (forward-line 0)
diff --git a/lisp/desktop.el b/lisp/desktop.el
index 5589097dfde..ce9d0c9d645 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -145,8 +145,11 @@ The base name of the file is specified in `desktop-base-file-name'."
145 :group 'desktop) 145 :group 'desktop)
146 146
147(defcustom desktop-missing-file-warning nil 147(defcustom desktop-missing-file-warning nil
148 "*If non-nil then `desktop-read' warns when a file no longer exists. 148 "*If non-nil then `desktop-read' asks if a non-existent file should be recreated.
149Otherwise it simply ignores that file." 149Also pause for a moment to display message about errors signaled in
150`desktop-buffer-mode-handlers'.
151
152If nil, just print error messages in the message buffer."
150 :type 'boolean 153 :type 'boolean
151 :group 'desktop) 154 :group 'desktop)
152 155
@@ -244,15 +247,6 @@ The variables are saved only when they really are local."
244 :type 'regexp 247 :type 'regexp
245 :group 'desktop) 248 :group 'desktop)
246 249
247(defcustom desktop-buffer-modes-to-save
248 '(Info-mode rmail-mode)
249 "If a buffer is of one of these major modes, save the buffer state.
250This applies to buffers not visiting a file and not beeing a dired buffer.
251Modes specified here must have a handler in `desktop-buffer-mode-handlers'
252to be restored."
253 :type '(repeat symbol)
254 :group 'desktop)
255
256(defcustom desktop-modes-not-to-save nil 250(defcustom desktop-modes-not-to-save nil
257 "List of major modes whose buffers should not be saved." 251 "List of major modes whose buffers should not be saved."
258 :type '(repeat symbol) 252 :type '(repeat symbol)
@@ -268,21 +262,25 @@ Possible values are:
268 :group 'desktop) 262 :group 'desktop)
269 263
270;;;###autoload 264;;;###autoload
271(defvar desktop-buffer-misc-data-function nil 265(defvar desktop-save-buffer nil
272 "Function returning major mode specific data for desktop file. 266 "When non-nil, save buffer status in desktop file.
273This variable becomes buffer local when set. 267This variable becomes buffer local when set.
274The function specified is called by `desktop-save', with argument 268
275DESKTOP-DIRNAME. If it returns non-nil, its value is saved along 269If the value is a function, it called by `desktop-save' with argument
276with the state of the buffer for which it was called. 270DESKTOP-DIRNAME to obtain auxiliary information to saved in the desktop
271file along with the state of the buffer for which it was called.
277 272
278When file names are returned, they should be formatted using the call 273When file names are returned, they should be formatted using the call
279\"(desktop-file-name FILE-NAME DESKTOP-DIRNAME)\". 274\"(desktop-file-name FILE-NAME DESKTOP-DIRNAME)\".
280 275
281Later, when `desktop-read' calls a function in `desktop-buffer-mode-handlers' 276Later, when `desktop-read' calls a function in `desktop-buffer-mode-handlers'
282to restore the buffer, the auxiliary information is passed as argument.") 277to restore the buffer, the auxiliary information is passed as the argument
283(make-variable-buffer-local 'desktop-buffer-misc-data-function) 278DESKTOP-BUFFER-MISC.")
279(make-variable-buffer-local 'desktop-save-buffer)
280(make-obsolete-variable 'desktop-buffer-modes-to-save
281 'desktop-save-buffer)
284(make-obsolete-variable 'desktop-buffer-misc-functions 282(make-obsolete-variable 'desktop-buffer-misc-functions
285 'desktop-buffer-misc-data-function) 283 'desktop-save-buffer)
286 284
287(defcustom desktop-buffer-mode-handlers '( 285(defcustom desktop-buffer-mode-handlers '(
288 (dired-mode . dired-restore-desktop-buffer) 286 (dired-mode . dired-restore-desktop-buffer)
@@ -541,21 +539,20 @@ which means to truncate VAR's value to at most MAX-SIZE elements
541 539
542;; ---------------------------------------------------------------------------- 540;; ----------------------------------------------------------------------------
543(defun desktop-save-buffer-p (filename bufname mode &rest dummy) 541(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
544 "Return t if the desktop should record a particular buffer for next startup. 542 "Return t if buffer should have its state saved in the desktop file.
545FILENAME is the visited file name, BUFNAME is the buffer name, and 543FILENAME is the visited file name, BUFNAME is the buffer name, and
546MODE is the major mode." 544MODE is the major mode."
547 (let ((case-fold-search nil)) 545 (let ((case-fold-search nil))
548 (and (not (string-match desktop-buffers-not-to-save bufname)) 546 (and (not (string-match desktop-buffers-not-to-save bufname))
549 (not (memq mode desktop-modes-not-to-save)) 547 (not (memq mode desktop-modes-not-to-save))
550 (or (and filename 548 (or (and filename
551 (not (string-match desktop-files-not-to-save filename))) 549 (not (string-match desktop-files-not-to-save filename)))
552 (and (eq mode 'dired-mode) 550 (and (eq mode 'dired-mode)
553 (save-excursion 551 (with-current-buffer bufname
554 (set-buffer (get-buffer bufname)) 552 (not (string-match desktop-files-not-to-save
555 (not (string-match desktop-files-not-to-save 553 default-directory))))
556 default-directory)))) 554 (and (null filename)
557 (and (null filename) 555 (with-current-buffer bufname desktop-save-buffer))))))
558 (memq mode desktop-buffer-modes-to-save))))))
559 556
560;; ---------------------------------------------------------------------------- 557;; ----------------------------------------------------------------------------
561(defun desktop-file-name (filename dirname) 558(defun desktop-file-name (filename dirname)
@@ -610,8 +607,8 @@ See also `desktop-base-file-name'."
610 (list (mark t) mark-active) 607 (list (mark t) mark-active)
611 buffer-read-only 608 buffer-read-only
612 ;; Auxiliary information 609 ;; Auxiliary information
613 (when desktop-buffer-misc-data-function 610 (when (functionp desktop-save-buffer)
614 (funcall desktop-buffer-misc-data-function dirname)) 611 (funcall desktop-save-buffer dirname))
615 (let ((locals desktop-locals-to-save) 612 (let ((locals desktop-locals-to-save)
616 (loclist (buffer-local-variables)) 613 (loclist (buffer-local-variables))
617 (ll)) 614 (ll))
@@ -813,8 +810,8 @@ directory DIRNAME."
813 nil))) 810 nil)))
814 811
815;; ---------------------------------------------------------------------------- 812;; ----------------------------------------------------------------------------
816;; Create a buffer, load its file, set is mode, ...; called from Desktop file 813;; Create a buffer, load its file, set its mode, ...;
817;; only. 814;; called from Desktop file only.
818 815
819(eval-when-compile ; Just to silence the byte compiler 816(eval-when-compile ; Just to silence the byte compiler
820 (defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read' 817 (defvar desktop-first-buffer) ;; Dynamically bound in `desktop-read'
diff --git a/lisp/diff.el b/lisp/diff.el
index 231130db212..76b1b5e60a7 100644
--- a/lisp/diff.el
+++ b/lisp/diff.el
@@ -111,6 +111,7 @@ With prefix arg, prompt for diff switches."
111 ,(shell-quote-argument (or new-alt new))) 111 ,(shell-quote-argument (or new-alt new)))
112 " ")) 112 " "))
113 (buf (get-buffer-create "*Diff*")) 113 (buf (get-buffer-create "*Diff*"))
114 (thisdir default-directory)
114 proc) 115 proc)
115 (save-excursion 116 (save-excursion
116 (display-buffer buf) 117 (display-buffer buf)
@@ -125,6 +126,7 @@ With prefix arg, prompt for diff switches."
125 (diff ',old ',new ',switches ',no-async))) 126 (diff ',old ',new ',switches ',no-async)))
126 (set (make-local-variable 'diff-old-temp-file) old-alt) 127 (set (make-local-variable 'diff-old-temp-file) old-alt)
127 (set (make-local-variable 'diff-new-temp-file) new-alt) 128 (set (make-local-variable 'diff-new-temp-file) new-alt)
129 (setq default-directory thisdir)
128 (insert command "\n") 130 (insert command "\n")
129 (if (and (not no-async) (fboundp 'start-process)) 131 (if (and (not no-async) (fboundp 'start-process))
130 (progn 132 (progn
diff --git a/lisp/dired.el b/lisp/dired.el
index 7440e3c3bfc..8bdfe1befce 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1160,6 +1160,8 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST."
1160 :help "Edit file at cursor")) 1160 :help "Edit file at cursor"))
1161 (define-key map [menu-bar immediate create-directory] 1161 (define-key map [menu-bar immediate create-directory]
1162 '(menu-item "Create Directory..." dired-create-directory)) 1162 '(menu-item "Create Directory..." dired-create-directory))
1163 (define-key map [menu-bar immediate wdired-mode]
1164 '(menu-item "Edit File Names" wdired-change-to-wdired-mode))
1163 1165
1164 (define-key map [menu-bar regexp] 1166 (define-key map [menu-bar regexp]
1165 (cons "Regexp" (make-sparse-keymap "Regexp"))) 1167 (cons "Regexp" (make-sparse-keymap "Regexp")))
@@ -1402,7 +1404,7 @@ Keybindings:
1402 (or switches dired-listing-switches)) 1404 (or switches dired-listing-switches))
1403 (set (make-local-variable 'font-lock-defaults) 1405 (set (make-local-variable 'font-lock-defaults)
1404 '(dired-font-lock-keywords t nil nil beginning-of-line)) 1406 '(dired-font-lock-keywords t nil nil beginning-of-line))
1405 (set (make-local-variable 'desktop-buffer-misc-data-function) 1407 (set (make-local-variable 'desktop-save-buffer)
1406 'dired-desktop-buffer-misc-data) 1408 'dired-desktop-buffer-misc-data)
1407 (dired-sort-other dired-actual-switches t) 1409 (dired-sort-other dired-actual-switches t)
1408 (run-mode-hooks 'dired-mode-hook) 1410 (run-mode-hooks 'dired-mode-hook)
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index a4e08ef7970..67de4a96223 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -2579,52 +2579,23 @@ This function will not modify `match-data'."
2579;;; Warning management 2579;;; Warning management
2580;; 2580;;
2581(defvar checkdoc-output-font-lock-keywords 2581(defvar checkdoc-output-font-lock-keywords
2582 '(("\\(\\w+\\.el\\): \\(\\w+\\)" 2582 '(("^\\*\\*\\* \\(.+\\.el\\): \\([^ \n]+\\)"
2583 (1 font-lock-function-name-face) 2583 (1 font-lock-function-name-face)
2584 (2 font-lock-comment-face)) 2584 (2 font-lock-comment-face)))
2585 ("^\\(\\w+\\.el\\):" 1 font-lock-function-name-face)
2586 (":\\([0-9]+\\):" 1 font-lock-constant-face))
2587 "Keywords used to highlight a checkdoc diagnostic buffer.") 2585 "Keywords used to highlight a checkdoc diagnostic buffer.")
2588 2586
2589(defvar checkdoc-output-mode-map nil 2587(defvar checkdoc-output-error-regex-alist
2590 "Keymap used in `checkdoc-output-mode'.") 2588 '(("^\\(.+\\.el\\):\\([0-9]+\\): " 1 2)))
2591 2589
2592(defvar checkdoc-pending-errors nil 2590(defvar checkdoc-pending-errors nil
2593 "Non-nil when there are errors that have not been displayed yet.") 2591 "Non-nil when there are errors that have not been displayed yet.")
2594 2592
2595(if checkdoc-output-mode-map 2593(define-derived-mode checkdoc-output-mode compilation-mode "Checkdoc"
2596 nil 2594 "Set up the major mode for the buffer containing the list of errors."
2597 (setq checkdoc-output-mode-map (make-sparse-keymap)) 2595 (set (make-local-variable 'compilation-error-regexp-alist)
2598 (if (not (string-match "XEmacs" emacs-version)) 2596 checkdoc-output-error-regex-alist)
2599 (define-key checkdoc-output-mode-map [mouse-2] 2597 (set (make-local-variable 'compilation-mode-font-lock-keywords)
2600 'checkdoc-find-error)) 2598 checkdoc-output-font-lock-keywords))
2601 (define-key checkdoc-output-mode-map "\C-c\C-c" 'checkdoc-find-error)
2602 (define-key checkdoc-output-mode-map "\C-m" 'checkdoc-find-error))
2603
2604(defun checkdoc-output-mode ()
2605 "Create and setup the buffer used to maintain checkdoc warnings.
2606\\<checkdoc-output-mode-map>\\[checkdoc-find-error] - Go to this error location."
2607 (kill-all-local-variables)
2608 (setq mode-name "Checkdoc"
2609 major-mode 'checkdoc-output-mode)
2610 (set (make-local-variable 'font-lock-defaults)
2611 '((checkdoc-output-font-lock-keywords) t t ((?- . "w") (?_ . "w"))))
2612 (use-local-map checkdoc-output-mode-map)
2613 (run-mode-hooks 'checkdoc-output-mode-hook))
2614
2615(defalias 'checkdoc-find-error-mouse 'checkdoc-find-error)
2616(defun checkdoc-find-error (&optional event)
2617 "In a checkdoc diagnostic buffer, find the error under point."
2618 (interactive (list last-input-event))
2619 (if event (posn-set-point (event-end e)))
2620 (beginning-of-line)
2621 (if (looking-at "\\(\\(\\w+\\|\\s_\\)+\\.el\\):\\([0-9]+\\):")
2622 (let ((l (string-to-int (match-string 3)))
2623 (f (match-string 1)))
2624 (if (not (get-file-buffer f))
2625 (error "Can't find buffer %s" f))
2626 (switch-to-buffer-other-window (get-file-buffer f))
2627 (goto-line l))))
2628 2599
2629(defun checkdoc-buffer-label () 2600(defun checkdoc-buffer-label ()
2630 "The name to use for a checkdoc buffer in the error list." 2601 "The name to use for a checkdoc buffer in the error list."
diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el
index 6656cf5ed3c..d4a10104eea 100644
--- a/lisp/emacs-lisp/rx.el
+++ b/lisp/emacs-lisp/rx.el
@@ -1,6 +1,6 @@
1;;; rx.el --- sexp notation for regular expressions 1;;; rx.el --- sexp notation for regular expressions
2 2
3;; Copyright (C) 2001, 2003, 2004 Free Software Foundation, Inc. 3;; Copyright (C) 2001, 03, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Gerd Moellmann <gerd@gnu.org> 5;; Author: Gerd Moellmann <gerd@gnu.org>
6;; Maintainer: FSF 6;; Maintainer: FSF
@@ -32,6 +32,22 @@
32;; from the bugs mentioned in the commentary section of Sregex, and 32;; from the bugs mentioned in the commentary section of Sregex, and
33;; uses a nicer syntax (IMHO, of course :-). 33;; uses a nicer syntax (IMHO, of course :-).
34 34
35;; This significantly extended version of the original, is almost
36;; compatible with Sregex. The only incompatibility I (fx) know of is
37;; that the `repeat' form can't have multiple regexp args.
38
39;; Now alternative forms are provided for a degree of compatibility
40;; with Shivers' attempted definitive SRE notation
41;; <URL:http://www.ai.mit.edu/~/shivers/sre.txt>. SRE forms not
42;; catered for include: dsm, uncase, w/case, w/nocase, ,@<exp>,
43;; ,<exp>, (word ...), word+, posix-string, and character class forms.
44;; Some forms are inconsistent with SRE, either for historical reasons
45;; or because of the implementation -- simple translation into Emacs
46;; regexp strings. These include: any, word. Also, case-sensitivity
47;; and greediness are controlled by variables external to the regexp,
48;; and you need to feed the forms to the `posix-' functions to get
49;; SRE's POSIX semantics. There are probably more difficulties.
50
35;; Rx translates a sexp notation for regular expressions into the 51;; Rx translates a sexp notation for regular expressions into the
36;; usual string notation. The translation can be done at compile-time 52;; usual string notation. The translation can be done at compile-time
37;; by using the `rx' macro. It can be done at run-time by calling 53;; by using the `rx' macro. It can be done at run-time by calling
@@ -94,62 +110,103 @@
94 110
95;;; Code: 111;;; Code:
96 112
97
98(defconst rx-constituents 113(defconst rx-constituents
99 '((and . (rx-and 1 nil)) 114 '((and . (rx-and 1 nil))
115 (seq . and) ; SRE
116 (: . and) ; SRE
117 (sequence . and) ; sregex
100 (or . (rx-or 1 nil)) 118 (or . (rx-or 1 nil))
119 (| . or) ; SRE
101 (not-newline . ".") 120 (not-newline . ".")
121 (nonl . not-newline) ; SRE
102 (anything . ".\\|\n") 122 (anything . ".\\|\n")
103 (any . (rx-any 1 1 rx-check-any)) 123 (any . (rx-any 1 nil rx-check-any)) ; inconsistent with SRE
104 (in . any) 124 (in . any)
125 (char . any) ; sregex
126 (not-char . (rx-not-char 1 nil rx-check-any)) ; sregex
105 (not . (rx-not 1 1 rx-check-not)) 127 (not . (rx-not 1 1 rx-check-not))
128 ;; Partially consistent with sregex, whose `repeat' is like our
129 ;; `**'. (`repeat' with optional max arg and multiple sexp forms
130 ;; is ambiguous.)
106 (repeat . (rx-repeat 2 3)) 131 (repeat . (rx-repeat 2 3))
107 (submatch . (rx-submatch 1 nil)) 132 (= . (rx-= 2 nil)) ; SRE
133 (>= . (rx->= 2 nil)) ; SRE
134 (** . (rx-** 2 nil)) ; SRE
135 (submatch . (rx-submatch 1 nil)) ; SRE
108 (group . submatch) 136 (group . submatch)
109 (zero-or-more . (rx-kleene 1 1)) 137 (zero-or-more . (rx-kleene 1 nil))
110 (one-or-more . (rx-kleene 1 1)) 138 (one-or-more . (rx-kleene 1 nil))
111 (zero-or-one . (rx-kleene 1 1)) 139 (zero-or-one . (rx-kleene 1 nil))
112 (\? . zero-or-one) 140 (\? . zero-or-one) ; SRE
113 (\?? . zero-or-one) 141 (\?? . zero-or-one)
114 (* . zero-or-more) 142 (* . zero-or-more) ; SRE
115 (*? . zero-or-more) 143 (*? . zero-or-more)
116 (0+ . zero-or-more) 144 (0+ . zero-or-more)
117 (+ . one-or-more) 145 (+ . one-or-more) ; SRE
118 (+? . one-or-more) 146 (+? . one-or-more)
119 (1+ . one-or-more) 147 (1+ . one-or-more)
120 (optional . zero-or-one) 148 (optional . zero-or-one)
149 (opt . zero-or-one) ; sregex
121 (minimal-match . (rx-greedy 1 1)) 150 (minimal-match . (rx-greedy 1 1))
122 (maximal-match . (rx-greedy 1 1)) 151 (maximal-match . (rx-greedy 1 1))
123 (backref . (rx-backref 1 1 rx-check-backref)) 152 (backref . (rx-backref 1 1 rx-check-backref))
124 (line-start . "^") 153 (line-start . "^")
154 (bol . line-start) ; SRE
125 (line-end . "$") 155 (line-end . "$")
156 (eol . line-end) ; SRE
126 (string-start . "\\`") 157 (string-start . "\\`")
158 (bos . string-start) ; SRE
159 (bot . string-start) ; sregex
127 (string-end . "\\'") 160 (string-end . "\\'")
161 (eos . string-end) ; SRE
162 (eot . string-end) ; sregex
128 (buffer-start . "\\`") 163 (buffer-start . "\\`")
129 (buffer-end . "\\'") 164 (buffer-end . "\\'")
130 (point . "\\=") 165 (point . "\\=")
131 (word-start . "\\<") 166 (word-start . "\\<")
167 (bow . word-start) ; SRE
132 (word-end . "\\>") 168 (word-end . "\\>")
169 (eow . word-end) ; SRE
133 (word-boundary . "\\b") 170 (word-boundary . "\\b")
171 (not-word-boundary . "\\B") ; sregex
134 (syntax . (rx-syntax 1 1)) 172 (syntax . (rx-syntax 1 1))
173 (not-syntax . (rx-not-syntax 1 1)) ; sregex
135 (category . (rx-category 1 1 rx-check-category)) 174 (category . (rx-category 1 1 rx-check-category))
136 (eval . (rx-eval 1 1)) 175 (eval . (rx-eval 1 1))
137 (regexp . (rx-regexp 1 1 stringp)) 176 (regexp . (rx-regexp 1 1 stringp))
138 (digit . "[[:digit:]]") 177 (digit . "[[:digit:]]")
139 (control . "[[:cntrl:]]") 178 (numeric . digit) ; SRE
140 (hex-digit . "[[:xdigit:]]") 179 (num . digit) ; SRE
141 (blank . "[[:blank:]]") 180 (control . "[[:cntrl:]]") ; SRE
142 (graphic . "[[:graph:]]") 181 (cntrl . control) ; SRE
143 (printing . "[[:print:]]") 182 (hex-digit . "[[:xdigit:]]") ; SRE
144 (alphanumeric . "[[:alnum:]]") 183 (hex . hex-digit) ; SRE
184 (xdigit . hex-digit) ; SRE
185 (blank . "[[:blank:]]") ; SRE
186 (graphic . "[[:graph:]]") ; SRE
187 (graph . graphic) ; SRE
188 (printing . "[[:print:]]") ; SRE
189 (print . printing) ; SRE
190 (alphanumeric . "[[:alnum:]]") ; SRE
191 (alnum . alphanumeric) ; SRE
145 (letter . "[[:alpha:]]") 192 (letter . "[[:alpha:]]")
146 (ascii . "[[:ascii:]]") 193 (alphabetic . letter) ; SRE
194 (alpha . letter) ; SRE
195 (ascii . "[[:ascii:]]") ; SRE
147 (nonascii . "[[:nonascii:]]") 196 (nonascii . "[[:nonascii:]]")
148 (lower . "[[:lower:]]") 197 (lower . "[[:lower:]]") ; SRE
149 (punctuation . "[[:punct:]]") 198 (lower-case . lower) ; SRE
150 (space . "[[:space:]]") 199 (punctuation . "[[:punct:]]") ; SRE
151 (upper . "[[:upper:]]") 200 (punct . punctuation) ; SRE
152 (word . "[[:word:]]")) 201 (space . "[[:space:]]") ; SRE
202 (whitespace . space) ; SRE
203 (white . space) ; SRE
204 (upper . "[[:upper:]]") ; SRE
205 (upper-case . upper) ; SRE
206 (word . "[[:word:]]") ; inconsistent with SRE
207 (wordchar . word) ; sregex
208 (not-wordchar . "[^[:word:]]") ; sregex (use \\W?)
209 )
153 "Alist of sexp form regexp constituents. 210 "Alist of sexp form regexp constituents.
154Each element of the alist has the form (SYMBOL . DEFN). 211Each element of the alist has the form (SYMBOL . DEFN).
155SYMBOL is a valid constituent of sexp regular expressions. 212SYMBOL is a valid constituent of sexp regular expressions.
@@ -252,6 +309,8 @@ See also `rx-constituents'."
252 309
253(defun rx-check (form) 310(defun rx-check (form)
254 "Check FORM according to its car's parsing info." 311 "Check FORM according to its car's parsing info."
312 (unless (listp form)
313 (error "rx `%s' needs argument(s)" form))
255 (let* ((rx (rx-info (car form))) 314 (let* ((rx (rx-info (car form)))
256 (nargs (1- (length form))) 315 (nargs (1- (length form)))
257 (min-args (nth 1 rx)) 316 (min-args (nth 1 rx))
@@ -297,53 +356,61 @@ FORM is of the form `(and FORM1 ...)'."
297 "\\)"))) 356 "\\)")))
298 357
299 358
300(defun rx-quote-for-set (string) 359(defvar rx-bracket) ; dynamically bound in `rx-any'
301 "Transform STRING for use in a character set.
302If STRING contains a `]', move it to the front.
303If STRING starts with a '^', move it to the end."
304 (when (string-match "\\`\\(\\(?:.\\|\n\\)+\\)\\]\\(\\(?:.\\|\n\\)\\)*\\'"
305 string)
306 (setq string (concat "]" (match-string 1 string)
307 (match-string 2 string))))
308 (when (string-match "\\`^\\(\\(?:.\\|\n\\)+\\)\\'" string)
309 (setq string (concat (substring string 1) "^")))
310 string)
311
312 360
313(defun rx-check-any (arg) 361(defun rx-check-any (arg)
314 "Check arg ARG for Rx `any'." 362 "Check arg ARG for Rx `any'."
315 (cond ((integerp arg) t) 363 (if (integerp arg)
316 ((and (stringp arg) (zerop (length arg))) 364 (setq arg (string arg)))
317 (error "String arg for rx `any' must not be empty")) 365 (when (stringp arg)
318 ((stringp arg) t) 366 (if (zerop (length arg))
319 (t 367 (error "String arg for Rx `any' must not be empty"))
320 (error "rx `any' requires string or character arg")))) 368 ;; Quote ^ at start; don't bother to check whether this is first arg.
321 369 (if (eq ?^ (aref arg 0))
370 (setq arg (concat "\\" arg)))
371 ;; Remove ] and set flag for adding it to start of overall result.
372 (when (string-match "]" arg)
373 (setq arg (replace-regexp-in-string "]" "" arg)
374 rx-bracket "]")))
375 (when (symbolp arg)
376 (let ((translation (condition-case nil
377 (rx-to-string arg 'no-group)
378 (error nil))))
379 (unless translation (error "Invalid char class `%s' in Rx `any'" arg))
380 (setq arg (substring translation 1 -1)))) ; strip outer brackets
381 ;; sregex compatibility
382 (when (and (integerp (car-safe arg))
383 (integerp (cdr-safe arg)))
384 (setq arg (string (car arg) ?- (cdr arg))))
385 (unless (stringp arg)
386 (error "rx `any' requires string, character, char pair or char class args"))
387 arg)
322 388
323(defun rx-any (form) 389(defun rx-any (form)
324 "Parse and produce code from FORM, which is `(any STRING)'. 390 "Parse and produce code from FORM, which is `(any ARG ...)'.
325STRING is optional. If it is omitted, build a regexp that 391ARG is optional."
326matches anything."
327 (rx-check form) 392 (rx-check form)
328 (let ((arg (cadr form))) 393 (let* ((rx-bracket nil)
329 (cond ((integerp arg) 394 (args (mapcar #'rx-check-any (cdr form)))) ; side-effects `rx-bracket'
330 (char-to-string arg)) 395 ;; If there was a ?- in the form, move it to the front to avoid
331 ((= (length arg) 1) 396 ;; accidental range.
332 arg) 397 (if (member "-" args)
333 (t 398 (setq args (cons "-" (delete "-" args))))
334 (concat "[" (rx-quote-for-set (cadr form)) "]"))))) 399 (apply #'concat "[" rx-bracket (append args '("]")))))
335 400
336 401
337(defun rx-check-not (arg) 402(defun rx-check-not (arg)
338 "Check arg ARG for Rx `not'." 403 "Check arg ARG for Rx `not'."
339 (unless (or (memq form 404 (unless (or (and (symbolp arg)
340 '(digit control hex-digit blank graphic printing 405 (string-match "\\`\\[\\[:[-a-z]:]]\\'"
341 alphanumeric letter ascii nonascii lower 406 (condition-case nil
342 punctuation space upper word)) 407 (rx-to-string arg 'no-group)
343 (and (consp form) 408 (error ""))))
344 (memq (car form) '(not any in syntax category:)))) 409 (eq arg 'word-boundary)
345 (error "rx `not' syntax error: %s" form)) 410 (and (consp arg)
346 t) 411 (memq (car arg) '(not any in syntax category))))
412 (error "rx `not' syntax error: %s" arg))
413 t)
347 414
348 415
349(defun rx-not (form) 416(defun rx-not (form)
@@ -355,24 +422,67 @@ matches anything."
355 (if (= (length result) 4) 422 (if (= (length result) 4)
356 (substring result 2 3) 423 (substring result 2 3)
357 (concat "[" (substring result 2)))) 424 (concat "[" (substring result 2))))
358 ((string-match "\\`\\[" result) 425 ((eq ?\[ (aref result 0))
359 (concat "[^" (substring result 1))) 426 (concat "[^" (substring result 1)))
360 ((string-match "\\`\\\\s." result) 427 ((string-match "\\`\\\\[scb]" result)
361 (concat "\\S" (substring result 2))) 428 (concat (capitalize (substring result 0 2)) (substring result 2)))
362 ((string-match "\\`\\\\S." result)
363 (concat "\\s" (substring result 2)))
364 ((string-match "\\`\\\\c." result)
365 (concat "\\C" (substring result 2)))
366 ((string-match "\\`\\\\C." result)
367 (concat "\\c" (substring result 2)))
368 ((string-match "\\`\\\\B" result)
369 (concat "\\b" (substring result 2)))
370 ((string-match "\\`\\\\b" result)
371 (concat "\\B" (substring result 2)))
372 (t 429 (t
373 (concat "[^" result "]"))))) 430 (concat "[^" result "]")))))
374 431
375 432
433(defun rx-not-char (form)
434 "Parse and produce code from FORM. FORM is `(not-char ...)'."
435 (rx-check form)
436 (rx-not `(not (in ,@(cdr form)))))
437
438
439(defun rx-not-syntax (form)
440 "Parse and produce code from FORM. FORM is `(not-syntax SYNTAX)'."
441 (rx-check form)
442 (rx-not `(not (syntax ,@(cdr form)))))
443
444
445(defun rx-trans-forms (form &optional skip)
446 "If FORM's length is greater than two, transform it to length two.
447A form (HEAD REST ...) becomes (HEAD (and REST ...)).
448If SKIP is non-nil, allow that number of items after the head, i.e.
449`(= N REST ...)' becomes `(= N (and REST ...))' if SKIP is 1."
450 (unless skip (setq skip 0))
451 (let ((tail (nthcdr (1+ skip) form)))
452 (if (= (length tail) 1)
453 form
454 (let ((form (copy-sequence form)))
455 (setcdr (nthcdr skip form) (list (cons 'and tail)))
456 form))))
457
458
459(defun rx-= (form)
460 "Parse and produce code from FORM `(= N ...)'."
461 (rx-check form)
462 (setq form (rx-trans-forms form 1))
463 (unless (and (integerp (nth 1 form))
464 (> (nth 1 form) 0))
465 (error "rx `=' requires positive integer first arg"))
466 (format "%s\\{%d\\}" (rx-to-string (nth 2 form)) (nth 1 form)))
467
468
469(defun rx->= (form)
470 "Parse and produce code from FORM `(>= N ...)'."
471 (rx-check form)
472 (setq form (rx-trans-forms form 1))
473 (unless (and (integerp (nth 1 form))
474 (> (nth 1 form) 0))
475 (error "rx `>=' requires positive integer first arg"))
476 (format "%s\\{%d,\\}" (rx-to-string (nth 2 form)) (nth 1 form)))
477
478
479(defun rx-** (form)
480 "Parse and produce code from FORM `(** N M ...)'."
481 (rx-check form)
482 (setq form (cons 'repeat (cdr (rx-trans-forms form 2))))
483 (rx-to-string form))
484
485
376(defun rx-repeat (form) 486(defun rx-repeat (form)
377 "Parse and produce code from FORM. 487 "Parse and produce code from FORM.
378FORM is either `(repeat N FORM1)' or `(repeat N M FORM1)'." 488FORM is either `(repeat N FORM1)' or `(repeat N M FORM1)'."
@@ -419,6 +529,7 @@ If OP is one of `*?', `+?', `??', produce a non-greedy regexp.
419If OP is anything else, produce a greedy regexp if `rx-greedy-flag' 529If OP is anything else, produce a greedy regexp if `rx-greedy-flag'
420is non-nil." 530is non-nil."
421 (rx-check form) 531 (rx-check form)
532 (setq form (rx-trans-forms form))
422 (let ((suffix (cond ((memq (car form) '(* + ? )) "") 533 (let ((suffix (cond ((memq (car form) '(* + ? )) "")
423 ((memq (car form) '(*? +? ??)) "?") 534 ((memq (car form) '(*? +? ??)) "?")
424 (rx-greedy-flag "") 535 (rx-greedy-flag "")
@@ -468,9 +579,15 @@ of all atomic regexps."
468(defun rx-syntax (form) 579(defun rx-syntax (form)
469 "Parse and produce code from FORM, which is `(syntax SYMBOL)'." 580 "Parse and produce code from FORM, which is `(syntax SYMBOL)'."
470 (rx-check form) 581 (rx-check form)
471 (let ((syntax (assq (cadr form) rx-syntax))) 582 (let* ((sym (cadr form))
583 (syntax (assq sym rx-syntax)))
472 (unless syntax 584 (unless syntax
473 (error "Unknown rx syntax `%s'" (cadr form))) 585 ;; Try sregex compatibility.
586 (let ((name (symbol-name sym)))
587 (if (= 1 (length name))
588 (setq syntax (rassq (aref name 0) rx-syntax))))
589 (unless syntax
590 (error "Unknown rx syntax `%s'" (cadr form))))
474 (format "\\s%c" (cdr syntax)))) 591 (format "\\s%c" (cdr syntax))))
475 592
476 593
@@ -483,7 +600,7 @@ of all atomic regexps."
483 600
484 601
485(defun rx-category (form) 602(defun rx-category (form)
486 "Parse and produce code from FORM, which is `(category SYMBOL ...)'." 603 "Parse and produce code from FORM, which is `(category SYMBOL)'."
487 (rx-check form) 604 (rx-check form)
488 (let ((char (if (integerp (cadr form)) 605 (let ((char (if (integerp (cadr form))
489 (cadr form) 606 (cadr form)
@@ -543,8 +660,9 @@ NO-GROUP non-nil means don't put shy groups around the result."
543 660
544 661
545;;;###autoload 662;;;###autoload
546(defmacro rx (regexp) 663(defmacro rx (&rest regexps)
547 "Translate a regular expression REGEXP in sexp form to a regexp string. 664 "Translate regular expressions REGEXPS in sexp form to a regexp string.
665REGEXPS is a non-empty sequence of forms of the sort listed below.
548See also `rx-to-string' for how to do such a translation at run-time. 666See also `rx-to-string' for how to do such a translation at run-time.
549 667
550The following are valid subforms of regular expressions in sexp 668The following are valid subforms of regular expressions in sexp
@@ -556,53 +674,58 @@ STRING
556CHAR 674CHAR
557 matches character CHAR literally. 675 matches character CHAR literally.
558 676
559`not-newline' 677`not-newline', `nonl'
560 matches any character except a newline. 678 matches any character except a newline.
561 . 679 .
562`anything' 680`anything'
563 matches any character 681 matches any character
564 682
565`(any SET)' 683`(any SET ...)'
566 matches any character in SET. SET may be a character or string. 684`(in SET ...)'
685`(char SET ...)'
686 matches any character in SET .... SET may be a character or string.
567 Ranges of characters can be specified as `A-Z' in strings. 687 Ranges of characters can be specified as `A-Z' in strings.
688 Ranges may also be specified as conses like `(?A . ?Z)'.
568 689
569'(in SET)' 690 SET may also be the name of a character class: `digit',
570 like `any'. 691 `control', `hex-digit', `blank', `graph', `print', `alnum',
692 `alpha', `ascii', `nonascii', `lower', `punct', `space', `upper',
693 `word', or one of their synonyms.
571 694
572`(not (any SET))' 695`(not (any SET ...))'
573 matches any character not in SET 696 matches any character not in SET ...
574 697
575`line-start' 698`line-start', `bol'
576 matches the empty string, but only at the beginning of a line 699 matches the empty string, but only at the beginning of a line
577 in the text being matched 700 in the text being matched
578 701
579`line-end' 702`line-end', `eol'
580 is similar to `line-start' but matches only at the end of a line 703 is similar to `line-start' but matches only at the end of a line
581 704
582`string-start' 705`string-start', `bos', `bot'
583 matches the empty string, but only at the beginning of the 706 matches the empty string, but only at the beginning of the
584 string being matched against. 707 string being matched against.
585 708
586`string-end' 709`string-end', `eos', `eot'
587 matches the empty string, but only at the end of the 710 matches the empty string, but only at the end of the
588 string being matched against. 711 string being matched against.
589 712
590`buffer-start' 713`buffer-start'
591 matches the empty string, but only at the beginning of the 714 matches the empty string, but only at the beginning of the
592 buffer being matched against. 715 buffer being matched against. Actually equivalent to `string-start'.
593 716
594`buffer-end' 717`buffer-end'
595 matches the empty string, but only at the end of the 718 matches the empty string, but only at the end of the
596 buffer being matched against. 719 buffer being matched against. Actually equivalent to `string-end'.
597 720
598`point' 721`point'
599 matches the empty string, but only at point. 722 matches the empty string, but only at point.
600 723
601`word-start' 724`word-start', `bow'
602 matches the empty string, but only at the beginning or end of a 725 matches the empty string, but only at the beginning or end of a
603 word. 726 word.
604 727
605`word-end' 728`word-end', `eow'
606 matches the empty string, but only at the end of a word. 729 matches the empty string, but only at the end of a word.
607 730
608`word-boundary' 731`word-boundary'
@@ -610,34 +733,35 @@ CHAR
610 word. 733 word.
611 734
612`(not word-boundary)' 735`(not word-boundary)'
736`not-word-boundary'
613 matches the empty string, but not at the beginning or end of a 737 matches the empty string, but not at the beginning or end of a
614 word. 738 word.
615 739
616`digit' 740`digit', `numeric', `num'
617 matches 0 through 9. 741 matches 0 through 9.
618 742
619`control' 743`control', `cntrl'
620 matches ASCII control characters. 744 matches ASCII control characters.
621 745
622`hex-digit' 746`hex-digit', `hex', `xdigit'
623 matches 0 through 9, a through f and A through F. 747 matches 0 through 9, a through f and A through F.
624 748
625`blank' 749`blank'
626 matches space and tab only. 750 matches space and tab only.
627 751
628`graphic' 752`graphic', `graph'
629 matches graphic characters--everything except ASCII control chars, 753 matches graphic characters--everything except ASCII control chars,
630 space, and DEL. 754 space, and DEL.
631 755
632`printing' 756`printing', `print'
633 matches printing characters--everything except ASCII control chars 757 matches printing characters--everything except ASCII control chars
634 and DEL. 758 and DEL.
635 759
636`alphanumeric' 760`alphanumeric', `alnum'
637 matches letters and digits. (But at present, for multibyte characters, 761 matches letters and digits. (But at present, for multibyte characters,
638 it matches anything that has word syntax.) 762 it matches anything that has word syntax.)
639 763
640`letter' 764`letter', `alphabetic', `alpha'
641 matches letters. (But at present, for multibyte characters, 765 matches letters. (But at present, for multibyte characters,
642 it matches anything that has word syntax.) 766 it matches anything that has word syntax.)
643 767
@@ -647,25 +771,29 @@ CHAR
647`nonascii' 771`nonascii'
648 matches non-ASCII (multibyte) characters. 772 matches non-ASCII (multibyte) characters.
649 773
650`lower' 774`lower', `lower-case'
651 matches anything lower-case. 775 matches anything lower-case.
652 776
653`upper' 777`upper', `upper-case'
654 matches anything upper-case. 778 matches anything upper-case.
655 779
656`punctuation' 780`punctuation', `punct'
657 matches punctuation. (But at present, for multibyte characters, 781 matches punctuation. (But at present, for multibyte characters,
658 it matches anything that has non-word syntax.) 782 it matches anything that has non-word syntax.)
659 783
660`space' 784`space', `whitespace', `white'
661 matches anything that has whitespace syntax. 785 matches anything that has whitespace syntax.
662 786
663`word' 787`word', `wordchar'
664 matches anything that has word syntax. 788 matches anything that has word syntax.
665 789
790`not-wordchar'
791 matches anything that has non-word syntax.
792
666`(syntax SYNTAX)' 793`(syntax SYNTAX)'
667 matches a character with syntax SYNTAX. SYNTAX must be one 794 matches a character with syntax SYNTAX. SYNTAX must be one
668 of the following symbols. 795 of the following symbols, or a symbol corresponding to the syntax
796 character, e.g. `\\.' for `\\s.'.
669 797
670 `whitespace' (\\s- in string notation) 798 `whitespace' (\\s- in string notation)
671 `punctuation' (\\s.) 799 `punctuation' (\\s.)
@@ -684,7 +812,7 @@ CHAR
684 `comment-delimiter' (\\s!) 812 `comment-delimiter' (\\s!)
685 813
686`(not (syntax SYNTAX))' 814`(not (syntax SYNTAX))'
687 matches a character that has not syntax SYNTAX. 815 matches a character that doesn't have syntax SYNTAX.
688 816
689`(category CATEGORY)' 817`(category CATEGORY)'
690 matches a character with category CATEGORY. CATEGORY must be 818 matches a character with category CATEGORY. CATEGORY must be
@@ -710,7 +838,7 @@ CHAR
710 `japanese-katakana-two-byte' (\\cK) 838 `japanese-katakana-two-byte' (\\cK)
711 `korean-hangul-two-byte' (\\cN) 839 `korean-hangul-two-byte' (\\cN)
712 `cyrillic-two-byte' (\\cY) 840 `cyrillic-two-byte' (\\cY)
713 `combining-diacritic' (\\c^) 841 `combining-diacritic' (\\c^)
714 `ascii' (\\ca) 842 `ascii' (\\ca)
715 `arabic' (\\cb) 843 `arabic' (\\cb)
716 `chinese' (\\cc) 844 `chinese' (\\cc)
@@ -731,12 +859,16 @@ CHAR
731 `can-break' (\\c|) 859 `can-break' (\\c|)
732 860
733`(not (category CATEGORY))' 861`(not (category CATEGORY))'
734 matches a character that has not category CATEGORY. 862 matches a character that doesn't have category CATEGORY.
735 863
736`(and SEXP1 SEXP2 ...)' 864`(and SEXP1 SEXP2 ...)'
865`(: SEXP1 SEXP2 ...)'
866`(seq SEXP1 SEXP2 ...)'
867`(sequence SEXP1 SEXP2 ...)'
737 matches what SEXP1 matches, followed by what SEXP2 matches, etc. 868 matches what SEXP1 matches, followed by what SEXP2 matches, etc.
738 869
739`(submatch SEXP1 SEXP2 ...)' 870`(submatch SEXP1 SEXP2 ...)'
871`(group SEXP1 SEXP2 ...)'
740 like `and', but makes the match accessible with `match-end', 872 like `and', but makes the match accessible with `match-end',
741 `match-beginning', and `match-string'. 873 `match-beginning', and `match-string'.
742 874
@@ -744,6 +876,7 @@ CHAR
744 another name for `submatch'. 876 another name for `submatch'.
745 877
746`(or SEXP1 SEXP2 ...)' 878`(or SEXP1 SEXP2 ...)'
879`(| SEXP1 SEXP2 ...)'
747 matches anything that matches SEXP1 or SEXP2, etc. If all 880 matches anything that matches SEXP1 or SEXP2, etc. If all
748 args are strings, use `regexp-opt' to optimize the resulting 881 args are strings, use `regexp-opt' to optimize the resulting
749 regular expression. 882 regular expression.
@@ -757,47 +890,55 @@ CHAR
757`(maximal-match SEXP)' 890`(maximal-match SEXP)'
758 produce a greedy regexp for SEXP. This is the default. 891 produce a greedy regexp for SEXP. This is the default.
759 892
760`(zero-or-more SEXP)' 893Below, `SEXP ...' represents a sequence of regexp forms, treated as if
761 matches zero or more occurrences of what SEXP matches. 894enclosed in `(and ...)'.
762
763`(0+ SEXP)'
764 like `zero-or-more'.
765 895
766`(* SEXP)' 896`(zero-or-more SEXP ...)'
767 like `zero-or-more', but always produces a greedy regexp. 897`(0+ SEXP ...)'
898 matches zero or more occurrences of what SEXP ... matches.
768 899
769`(*? SEXP)' 900`(* SEXP ...)'
770 like `zero-or-more', but always produces a non-greedy regexp. 901 like `zero-or-more', but always produces a greedy regexp, independent
902 of `rx-greedy-flag'.
771 903
772`(one-or-more SEXP)' 904`(*? SEXP ...)'
773 matches one or more occurrences of A. 905 like `zero-or-more', but always produces a non-greedy regexp,
906 independent of `rx-greedy-flag'.
774 907
775`(1+ SEXP)' 908`(one-or-more SEXP ...)'
776 like `one-or-more'. 909`(1+ SEXP ...)'
910 matches one or more occurrences of SEXP ...
777 911
778`(+ SEXP)' 912`(+ SEXP ...)'
779 like `one-or-more', but always produces a greedy regexp. 913 like `one-or-more', but always produces a greedy regexp.
780 914
781`(+? SEXP)' 915`(+? SEXP ...)'
782 like `one-or-more', but always produces a non-greedy regexp. 916 like `one-or-more', but always produces a non-greedy regexp.
783 917
784`(zero-or-one SEXP)' 918`(zero-or-one SEXP ...)'
919`(optional SEXP ...)'
920`(opt SEXP ...)'
785 matches zero or one occurrences of A. 921 matches zero or one occurrences of A.
786 922
787`(optional SEXP)' 923`(? SEXP ...)'
788 like `zero-or-one'.
789
790`(? SEXP)'
791 like `zero-or-one', but always produces a greedy regexp. 924 like `zero-or-one', but always produces a greedy regexp.
792 925
793`(?? SEXP)' 926`(?? SEXP ...)'
794 like `zero-or-one', but always produces a non-greedy regexp. 927 like `zero-or-one', but always produces a non-greedy regexp.
795 928
796`(repeat N SEXP)' 929`(repeat N SEXP)'
797 matches N occurrences of what SEXP matches. 930`(= N SEXP ...)'
931 matches N occurrences.
932
933`(>= N SEXP ...)'
934 matches N or more occurrences.
798 935
799`(repeat N M SEXP)' 936`(repeat N M SEXP)'
800 matches N to M occurrences of what SEXP matches. 937`(** N M SEXP ...)'
938 matches N to M occurrences.
939
940`(backref N)'
941 matches what was matched previously by submatch N.
801 942
802`(backref N)' 943`(backref N)'
803 matches what was matched previously by submatch N. 944 matches what was matched previously by submatch N.
@@ -811,9 +952,21 @@ CHAR
811 952
812`(regexp REGEXP)' 953`(regexp REGEXP)'
813 include REGEXP in string notation in the result." 954 include REGEXP in string notation in the result."
814 955 (cond ((null regexps)
815 (rx-to-string regexp)) 956 (error "No regexp"))
816 957 ((cdr regexps)
958 (rx-to-string `(and ,@regexps) t))
959 (t
960 (rx-to-string (car regexps) t))))
961
962;; ;; sregex.el replacement
963
964;; ;;;###autoload (provide 'sregex)
965;; ;;;###autoload (autoload 'sregex "rx")
966;; (defalias 'sregex 'rx-to-string)
967;; ;;;###autoload (autoload 'sregexq "rx" nil nil 'macro)
968;; (defalias 'sregexq 'rx)
969
817(provide 'rx) 970(provide 'rx)
818 971
819;;; arch-tag: 12d01a63-0008-42bb-ab8c-1c7d63be370b 972;;; arch-tag: 12d01a63-0008-42bb-ab8c-1c7d63be370b
diff --git a/lisp/help.el b/lisp/help.el
index b589de94474..fc43d8db03d 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1,6 +1,6 @@
1;;; help.el --- help commands for Emacs 1;;; help.el --- help commands for Emacs
2 2
3;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002 3;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2004
4;; Free Software Foundation, Inc. 4;; Free Software Foundation, Inc.
5 5
6;; Maintainer: FSF 6;; Maintainer: FSF
@@ -313,19 +313,61 @@ of the key sequence that ran this command."
313 313
314(defun view-emacs-news (&optional arg) 314(defun view-emacs-news (&optional arg)
315 "Display info on recent changes to Emacs. 315 "Display info on recent changes to Emacs.
316With numeric argument, display information on correspondingly older changes." 316With argument, display info only for the selected version."
317 (interactive "P") 317 (interactive "P")
318 (let* ((arg (if arg (prefix-numeric-value arg) 0)) 318 (if (not arg)
319 (file (cond ((eq arg 0) "NEWS") 319 (view-file (expand-file-name "NEWS" data-directory))
320 ((eq arg 1) "ONEWS") 320 (let* ((map (sort
321 (t 321 (delete-dups
322 (nth (- arg 2) 322 (apply
323 (nreverse (directory-files data-directory 323 'nconc
324 nil "^ONEWS\\.[0-9]+$" 324 (mapcar
325 nil))))))) 325 (lambda (file)
326 (if file 326 (with-temp-buffer
327 (view-file (expand-file-name file data-directory)) 327 (insert-file-contents
328 (error "No such old news")))) 328 (expand-file-name file data-directory))
329 (let (res)
330 (while (re-search-forward
331 (if (string-match "^ONEWS\\.[0-9]+$" file)
332 "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
333 "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)
334 (setq res (cons (list (match-string-no-properties 1)
335 file) res)))
336 res)))
337 (append '("NEWS" "ONEWS")
338 (directory-files data-directory nil
339 "^ONEWS\\.[0-9]+$" nil)))))
340 (lambda (a b)
341 (string< (car b) (car a)))))
342 (current (caar map))
343 (version (completing-read
344 (format "Read NEWS for the version (default %s): " current)
345 (mapcar 'car map) nil nil nil nil current))
346 (file (cadr (assoc version map)))
347 res)
348 (if (not file)
349 (error "No news is good news")
350 (view-file (expand-file-name file data-directory))
351 (widen)
352 (goto-char (point-min))
353 (when (re-search-forward
354 (concat (if (string-match "^ONEWS\\.[0-9]+$" file)
355 "Changes in \\(?:Emacs\\|version\\)?[ \t]*"
356 "^\* [^0-9\n]*") version)
357 nil t)
358 (beginning-of-line)
359 (narrow-to-region
360 (point)
361 (save-excursion
362 (while (and (setq res
363 (re-search-forward
364 (if (string-match "^ONEWS\\.[0-9]+$" file)
365 "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)"
366 "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t))
367 (equal (match-string-no-properties 1) version)))
368 (or res (goto-char (point-max)))
369 (beginning-of-line)
370 (point))))))))
329 371
330(defun view-todo (&optional arg) 372(defun view-todo (&optional arg)
331 "Display the Emacs TODO list." 373 "Display the Emacs TODO list."
diff --git a/lisp/ielm.el b/lisp/ielm.el
index aa60d5de6c3..0a249f65095 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -1,6 +1,6 @@
1;;; ielm.el --- interaction mode for Emacs Lisp 1;;; ielm.el --- interaction mode for Emacs Lisp
2 2
3;; Copyright (C) 1994, 2002, 2003 Free Software Foundation, Inc. 3;; Copyright (C) 1994, 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: David Smith <maa036@lancaster.ac.uk> 5;; Author: David Smith <maa036@lancaster.ac.uk>
6;; Maintainer: FSF 6;; Maintainer: FSF
@@ -49,12 +49,45 @@
49 :type 'boolean 49 :type 'boolean
50 :group 'ielm) 50 :group 'ielm)
51 51
52(defcustom ielm-prompt-read-only t
53 "If non-nil, the IELM prompt is read only.
54Setting this variable does not affect existing IELM runs.
55
56You can give the IELM prompt more highly customized read-only
57type properties, by setting this option to nil, and then setting
58`ielm-prompt', outside of Custom, to a string with the desired
59text properties.
60
61Interrupting the IELM process with \\<ielm-map>\\[comint-interrupt-subjob],
62and then restarting it using \\[ielm], makes the then current
63default value affect _new_ prompts. However, executing \\[ielm]
64does not have this effect on *ielm* buffers with a running process.
65For IELM buffers that are not called `*ielm*', you can execute
66\\[inferior-emacs-lisp-mode] in that IELM buffer to update the value,
67for new prompts. This works even if the buffer has a running process."
68 :type 'boolean
69 :group 'ielm
70 :version "21.4")
71
52(defcustom ielm-prompt "ELISP> " 72(defcustom ielm-prompt "ELISP> "
53 "Prompt used in IELM." 73 "Prompt used in IELM.
74Setting the default value does not affect existing IELM runs.
75`inferior-emacs-lisp-mode' converts this into a buffer-local
76variable in IELM buffers. The buffer-local value is meant for
77internal use by IELM. Do not try to set the buffer-local value
78yourself in any way, unless you really know what you are doing.
79
80Interrupting the IELM process with \\<ielm-map>\\[comint-interrupt-subjob],
81and then restarting it using \\[ielm], makes the then current
82_default_ value affect _new_ prompts. Unless the new prompt
83differs only in text properties from the old one, IELM will no
84longer recognize the old prompts. However, executing \\[ielm]
85does not update the prompt of an *ielm* buffer with a running process.
86For IELM buffers that are not called `*ielm*', you can execute
87\\[inferior-emacs-lisp-mode] in that IELM buffer to update the value,
88for new prompts. This works even if the buffer has a running process."
54 :type 'string 89 :type 'string
55 :group 'ielm 90 :group 'ielm)
56 :get #'(lambda (symbol) (substring-no-properties (symbol-value symbol)))
57 :set #'(lambda (symbol value) (set symbol (propertize value 'read-only t 'rear-nonsticky t))))
58 91
59(defcustom ielm-dynamic-return t 92(defcustom ielm-dynamic-return t
60 "*Controls whether \\<ielm-map>\\[ielm-return] has intelligent behaviour in IELM. 93 "*Controls whether \\<ielm-map>\\[ielm-return] has intelligent behaviour in IELM.
@@ -414,8 +447,8 @@ The current working buffer may be changed (with a call to
414`set-buffer', or with \\[ielm-change-working-buffer]), and its value 447`set-buffer', or with \\[ielm-change-working-buffer]), and its value
415is preserved between successive evaluations. In this way, expressions 448is preserved between successive evaluations. In this way, expressions
416may be evaluated in a different buffer than the *ielm* buffer. 449may be evaluated in a different buffer than the *ielm* buffer.
417Display the name of the working buffer with \\[ielm-print-working-buffer], 450By default, its name is shown on the mode line; you can always display
418or the buffer itself with \\[ielm-display-working-buffer]. 451it with \\[ielm-print-working-buffer], or the buffer itself with \\[ielm-display-working-buffer].
419 452
420During evaluations, the values of the variables `*', `**', and `***' 453During evaluations, the values of the variables `*', `**', and `***'
421are the results of the previous, second previous and third previous 454are the results of the previous, second previous and third previous
@@ -426,14 +459,16 @@ buffer, then the values in the working buffer are used. The variables
426Expressions evaluated by IELM are not subject to `debug-on-quit' or 459Expressions evaluated by IELM are not subject to `debug-on-quit' or
427`debug-on-error'. 460`debug-on-error'.
428 461
429The behaviour of IELM may be customised with the following variables: 462The behaviour of IELM may be customized with the following variables:
430* To stop beeping on error, set `ielm-noisy' to nil 463* To stop beeping on error, set `ielm-noisy' to nil.
431* If you don't like the prompt, you can change it by setting `ielm-prompt'. 464* If you don't like the prompt, you can change it by setting `ielm-prompt'.
432* Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode' 465* If you do not like that the prompt is (by default) read-only, set
466 `ielm-prompt-read-only' to nil.
467* Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode'.
433* Entry to this mode runs `comint-mode-hook' and `ielm-mode-hook' 468* Entry to this mode runs `comint-mode-hook' and `ielm-mode-hook'
434 (in that order). 469 (in that order).
435 470
436Customised bindings may be defined in `ielm-map', which currently contains: 471Customized bindings may be defined in `ielm-map', which currently contains:
437\\{ielm-map}" 472\\{ielm-map}"
438 (interactive) 473 (interactive)
439 (comint-mode) 474 (comint-mode)
@@ -443,6 +478,13 @@ Customised bindings may be defined in `ielm-map', which currently contains:
443 (setq comint-input-sender 'ielm-input-sender) 478 (setq comint-input-sender 'ielm-input-sender)
444 (setq comint-process-echoes nil) 479 (setq comint-process-echoes nil)
445 (make-local-variable 'comint-dynamic-complete-functions) 480 (make-local-variable 'comint-dynamic-complete-functions)
481 (set (make-local-variable 'ielm-prompt)
482 (if ielm-prompt-read-only
483 (propertize ielm-prompt
484 'read-only t
485 'rear-nonsticky t
486 'front-sticky '(read-only))
487 ielm-prompt))
446 (setq comint-dynamic-complete-functions 488 (setq comint-dynamic-complete-functions
447 '(ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol)) 489 '(ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol))
448 (setq comint-get-old-input 'ielm-get-old-input) 490 (setq comint-get-old-input 'ielm-get-old-input)
@@ -452,6 +494,7 @@ Customised bindings may be defined in `ielm-map', which currently contains:
452 494
453 (setq major-mode 'inferior-emacs-lisp-mode) 495 (setq major-mode 'inferior-emacs-lisp-mode)
454 (setq mode-name "IELM") 496 (setq mode-name "IELM")
497 (setq mode-line-process '(":%s on " (:eval (buffer-name ielm-working-buffer))))
455 (use-local-map ielm-map) 498 (use-local-map ielm-map)
456 (set-syntax-table emacs-lisp-mode-syntax-table) 499 (set-syntax-table emacs-lisp-mode-syntax-table)
457 500
@@ -494,9 +537,10 @@ Customised bindings may be defined in `ielm-map', which currently contains:
494 (insert ielm-header) 537 (insert ielm-header)
495 (ielm-set-pm (point-max)) 538 (ielm-set-pm (point-max))
496 (unless comint-use-prompt-regexp-instead-of-fields 539 (unless comint-use-prompt-regexp-instead-of-fields
497 (add-text-properties 540 (let ((inhibit-read-only t))
498 (point-min) (point-max) 541 (add-text-properties
499 '(rear-nonsticky t field output inhibit-line-move-field-capture t))) 542 (point-min) (point-max)
543 '(rear-nonsticky t field output inhibit-line-move-field-capture t))))
500 (comint-output-filter (ielm-process) ielm-prompt) 544 (comint-output-filter (ielm-process) ielm-prompt)
501 (set-marker comint-last-input-start (ielm-pm)) 545 (set-marker comint-last-input-start (ielm-pm))
502 (set-process-filter (get-buffer-process (current-buffer)) 'comint-output-filter)) 546 (set-process-filter (get-buffer-process (current-buffer)) 'comint-output-filter))
@@ -521,12 +565,13 @@ Customised bindings may be defined in `ielm-map', which currently contains:
521 "Interactively evaluate Emacs Lisp expressions. 565 "Interactively evaluate Emacs Lisp expressions.
522Switches to the buffer `*ielm*', or creates it if it does not exist." 566Switches to the buffer `*ielm*', or creates it if it does not exist."
523 (interactive) 567 (interactive)
524 (if (comint-check-proc "*ielm*") 568 (let (old-point)
525 nil 569 (unless (comint-check-proc "*ielm*")
526 (save-excursion 570 (with-current-buffer (get-buffer-create "*ielm*")
527 (set-buffer (get-buffer-create "*ielm*")) 571 (unless (eq (buffer-size) 0) (setq old-point (point)))
528 (inferior-emacs-lisp-mode))) 572 (inferior-emacs-lisp-mode)))
529 (pop-to-buffer "*ielm*")) 573 (pop-to-buffer "*ielm*")
574 (when old-point (push-mark old-point))))
530 575
531(provide 'ielm) 576(provide 'ielm)
532 577
diff --git a/lisp/image.el b/lisp/image.el
index 9d656794aa9..d2eb264f91e 100644
--- a/lisp/image.el
+++ b/lisp/image.el
@@ -241,7 +241,7 @@ height of the image; integer values are taken as pixel values."
241 (setq x (+ x dx)))) 241 (setq x (+ x dx))))
242 (setq x 0.0 242 (setq x 0.0
243 y (+ y dy)) 243 y (+ y dy))
244 (insert "\n")))) 244 (insert (propertize "\n" 'line-height 0)))))
245 245
246 246
247 247
diff --git a/lisp/info-look.el b/lisp/info-look.el
index 35138121838..8e09f326019 100644
--- a/lisp/info-look.el
+++ b/lisp/info-look.el
@@ -1,7 +1,7 @@
1;;; info-look.el --- major-mode-sensitive Info index lookup facility 1;;; info-look.el --- major-mode-sensitive Info index lookup facility
2;; An older version of this was known as libc.el. 2;; An older version of this was known as libc.el.
3 3
4;; Copyright (C) 1995,96,97,98,99,2001,2003,2004 Free Software Foundation, Inc. 4;; Copyright (C) 1995,96,97,98,99,2001,03,04 Free Software Foundation, Inc.
5 5
6;; Author: Ralph Schleicher <rs@nunatak.allgaeu.org> 6;; Author: Ralph Schleicher <rs@nunatak.allgaeu.org>
7;; (did not show signs of life (Nov 2001) -stef) 7;; (did not show signs of life (Nov 2001) -stef)
@@ -408,12 +408,11 @@ If optional argument QUERY is non-nil, query for the help mode."
408 (message "No %s help available for `%s'" topic mode) 408 (message "No %s help available for `%s'" topic mode)
409 ;; Recursively setup cross references. 409 ;; Recursively setup cross references.
410 ;; But refer only to non-void modes. 410 ;; But refer only to non-void modes.
411 (mapcar (lambda (arg) 411 (dolist (arg (info-lookup->other-modes topic mode))
412 (or (info-lookup->initialized topic arg) 412 (or (info-lookup->initialized topic arg)
413 (info-lookup-setup-mode topic arg)) 413 (info-lookup-setup-mode topic arg))
414 (and (eq (info-lookup->initialized topic arg) t) 414 (and (eq (info-lookup->initialized topic arg) t)
415 (setq refer-modes (cons arg refer-modes)))) 415 (setq refer-modes (cons arg refer-modes))))
416 (info-lookup->other-modes topic mode))
417 (setq refer-modes (nreverse refer-modes)) 416 (setq refer-modes (nreverse refer-modes))
418 ;; Build the full completion alist. 417 ;; Build the full completion alist.
419 (setq completions 418 (setq completions
@@ -887,6 +886,12 @@ Return nil if there is nothing appropriate in the buffer near point."
887 "awk") 886 "awk")
888 ((string-equal item "gawk, versions of, information about, printing") 887 ((string-equal item "gawk, versions of, information about, printing")
889 "gawk")))))) 888 "gawk"))))))
889
890(info-lookup-maybe-add-help
891 :mode 'cfengine-mode
892 :regexp "[[:alnum:]_]+"
893 :doc-spec '(("(cfengine-Reference)Variable Index" nil
894 "^ - [^:]+:[ ]+\\(\\[[^=]*=[ ]+\\)?" nil)))
890 895
891(provide 'info-look) 896(provide 'info-look)
892 897
diff --git a/lisp/info.el b/lisp/info.el
index a284ca7fa2e..a57078d5e2d 100644
--- a/lisp/info.el
+++ b/lisp/info.el
@@ -88,7 +88,7 @@ The Lisp code is executed when the node is selected.")
88(defface info-xref-visited 88(defface info-xref-visited
89 '((t :inherit info-xref) 89 '((t :inherit info-xref)
90 (((class color) (background light)) :foreground "magenta4") 90 (((class color) (background light)) :foreground "magenta4")
91 (((class color) (background dark)) :foreground "magenta4")) 91 (((class color) (background dark)) :foreground "magenta3")) ;"violet"?
92 "Face for visited Info cross-references." 92 "Face for visited Info cross-references."
93 :group 'info) 93 :group 'info)
94 94
@@ -239,10 +239,11 @@ Marker points nowhere if file has no tag table.")
239(defvar Info-index-alternatives nil 239(defvar Info-index-alternatives nil
240 "List of possible matches for last `Info-index' command.") 240 "List of possible matches for last `Info-index' command.")
241 241
242(defvar Info-reference-name nil 242(defvar Info-point-loc nil
243 "Name of the selected cross-reference. 243 "Point location within a selected node.
244Point is moved to the proper occurrence of this name within a node 244If string, the point is moved to the proper occurrence of the
245after selecting it.") 245name of the followed cross reference within a selected node.
246If number, the point is moved to the corresponding line.")
246 247
247(defvar Info-standalone nil 248(defvar Info-standalone nil
248 "Non-nil if Emacs was started solely as an Info browser.") 249 "Non-nil if Emacs was started solely as an Info browser.")
@@ -449,28 +450,38 @@ Do the right thing if the file has been compressed or zipped."
449 "Like `info' but show the Info buffer in another window." 450 "Like `info' but show the Info buffer in another window."
450 (interactive (if current-prefix-arg 451 (interactive (if current-prefix-arg
451 (list (read-file-name "Info file name: " nil nil t)))) 452 (list (read-file-name "Info file name: " nil nil t))))
452 (let (same-window-buffer-names) 453 (let (same-window-buffer-names same-window-regexps)
453 (info file))) 454 (info file)))
454 455
455;;;###autoload (add-hook 'same-window-buffer-names "*info*") 456;;;###autoload (add-hook 'same-window-regexps "\\*info\\*\\(\\|<[0-9]+>\\)")
456 457
457;;;###autoload 458;;;###autoload
458(defun info (&optional file) 459(defun info (&optional file buffer)
459 "Enter Info, the documentation browser. 460 "Enter Info, the documentation browser.
460Optional argument FILE specifies the file to examine; 461Optional argument FILE specifies the file to examine;
461the default is the top-level directory of Info. 462the default is the top-level directory of Info.
462Called from a program, FILE may specify an Info node of the form 463Called from a program, FILE may specify an Info node of the form
463`(FILENAME)NODENAME'. 464`(FILENAME)NODENAME'.
465Optional argument BUFFER specifies the Info buffer name;
466the default buffer name is *info*. If BUFFER exists,
467just switch to BUFFER. Otherwise, create a new buffer
468with the top-level Info directory.
464 469
465In interactive use, a prefix argument directs this command 470In interactive use, a non-numeric prefix argument directs
466to read a file name from the minibuffer. 471this command to read a file name from the minibuffer.
472A numeric prefix argument appends the number to the buffer name.
467 473
468The search path for Info files is in the variable `Info-directory-list'. 474The search path for Info files is in the variable `Info-directory-list'.
469The top-level Info directory is made by combining all the files named `dir' 475The top-level Info directory is made by combining all the files named `dir'
470in all the directories in that path." 476in all the directories in that path."
471 (interactive (if current-prefix-arg 477 (interactive (list
472 (list (read-file-name "Info file name: " nil nil t)))) 478 (if (and current-prefix-arg (not (numberp current-prefix-arg)))
473 (pop-to-buffer "*info*") 479 (read-file-name "Info file name: " nil nil t))
480 (if (numberp current-prefix-arg)
481 (format "*info*<%s>" current-prefix-arg))))
482 (pop-to-buffer (or buffer "*info*"))
483 (if (and buffer (not (eq major-mode 'Info-mode)))
484 (Info-mode))
474 (if file 485 (if file
475 ;; If argument already contains parentheses, don't add another set 486 ;; If argument already contains parentheses, don't add another set
476 ;; since the argument will then be parsed improperly. This also 487 ;; since the argument will then be parsed improperly. This also
@@ -866,9 +877,12 @@ a case-insensitive match is tried."
866 (cons new-history 877 (cons new-history
867 (delete new-history Info-history-list)))) 878 (delete new-history Info-history-list))))
868 (goto-char anchorpos)) 879 (goto-char anchorpos))
869 (Info-reference-name 880 ((numberp Info-point-loc)
870 (Info-find-index-name Info-reference-name) 881 (forward-line (1- Info-point-loc))
871 (setq Info-reference-name nil)))))) 882 (setq Info-point-loc nil))
883 ((stringp Info-point-loc)
884 (Info-find-index-name Info-point-loc)
885 (setq Info-point-loc nil))))))
872 ;; If we did not finish finding the specified node, 886 ;; If we did not finish finding the specified node,
873 ;; go back to the previous one. 887 ;; go back to the previous one.
874 (or Info-current-node no-going-back (null Info-history) 888 (or Info-current-node no-going-back (null Info-history)
@@ -1313,9 +1327,9 @@ If FORK is a string, it is the name to use for the new buffer."
1313 "" 1327 ""
1314 (match-string 2 nodename)) 1328 (match-string 2 nodename))
1315 nodename (match-string 3 nodename)) 1329 nodename (match-string 3 nodename))
1316 (let ((trim (string-match "\\s *\\'" filename))) 1330 (let ((trim (string-match "\\s +\\'" filename)))
1317 (if trim (setq filename (substring filename 0 trim)))) 1331 (if trim (setq filename (substring filename 0 trim))))
1318 (let ((trim (string-match "\\s *\\'" nodename))) 1332 (let ((trim (string-match "\\s +\\'" nodename)))
1319 (if trim (setq nodename (substring nodename 0 trim)))) 1333 (if trim (setq nodename (substring nodename 0 trim))))
1320 (if transient-mark-mode (deactivate-mark)) 1334 (if transient-mark-mode (deactivate-mark))
1321 (Info-find-node (if (equal filename "") nil filename) 1335 (Info-find-node (if (equal filename "") nil filename)
@@ -1664,10 +1678,11 @@ If SAME-FILE is non-nil, do not move to a different Info file."
1664 (insert "*Note Top::\n") 1678 (insert "*Note Top::\n")
1665 (Info-insert-toc 1679 (Info-insert-toc
1666 (nth 2 (assoc "Top" node-list)) ; get Top nodes 1680 (nth 2 (assoc "Top" node-list)) ; get Top nodes
1667 node-list 0 (file-name-nondirectory curr-file))) 1681 node-list 0 curr-file))
1668 (if (not (bobp)) 1682 (if (not (bobp))
1669 (let ((Info-hide-note-references 'hide) 1683 (let ((Info-hide-note-references 'hide)
1670 (Info-fontify-visited-nodes nil)) 1684 (Info-fontify-visited-nodes nil))
1685 (setq Info-current-node "Top")
1671 (Info-fontify-node))) 1686 (Info-fontify-node)))
1672 (goto-char (point-min)) 1687 (goto-char (point-min))
1673 (if (setq p (search-forward (concat "*Note " curr-node ":") nil t)) 1688 (if (setq p (search-forward (concat "*Note " curr-node ":") nil t))
@@ -1829,8 +1844,7 @@ new buffer."
1829 (if (and (save-excursion 1844 (if (and (save-excursion
1830 (goto-char (+ (point) 5)) ; skip a possible *note 1845 (goto-char (+ (point) 5)) ; skip a possible *note
1831 (re-search-backward "\\*note[ \n\t]+" nil t) 1846 (re-search-backward "\\*note[ \n\t]+" nil t)
1832 (looking-at (concat "\\*note[ \n\t]+" 1847 (looking-at str))
1833 (Info-following-node-name-re "^.,\t"))))
1834 (<= (point) (match-end 0))) 1848 (<= (point) (match-end 0)))
1835 (goto-char (match-beginning 0)))) 1849 (goto-char (match-beginning 0))))
1836 ;; Go to the reference closest to point 1850 ;; Go to the reference closest to point
@@ -1858,11 +1872,27 @@ new buffer."
1858Because of ambiguities, this should be concatenated with something like 1872Because of ambiguities, this should be concatenated with something like
1859`:' and `Info-following-node-name-re'.") 1873`:' and `Info-following-node-name-re'.")
1860 1874
1861(defun Info-extract-menu-node-name (&optional multi-line) 1875(defun Info-extract-menu-node-name (&optional multi-line index-node)
1862 (skip-chars-forward " \t\n") 1876 (skip-chars-forward " \t\n")
1863 (when (looking-at (concat Info-menu-entry-name-re ":\\(:\\|" 1877 (when (looking-at (concat Info-menu-entry-name-re ":\\(:\\|"
1864 (Info-following-node-name-re 1878 (Info-following-node-name-re
1865 (if multi-line "^.,\t" "^.,\t\n")) "\\)")) 1879 (cond
1880 (index-node "^,\t\n")
1881 (multi-line "^.,\t")
1882 (t "^.,\t\n")))
1883 "\\)"
1884 (if index-node
1885 "\\.\\(?:[ \t\n]+(line +\\([0-9]+\\))\\)?"
1886 "")))
1887 (if index-node
1888 (setq Info-point-loc
1889 (if (match-beginning 5)
1890 (string-to-number (match-string 5))
1891 (buffer-substring (match-beginning 0) (1- (match-beginning 1)))))
1892;;; Comment out the next line to use names of cross-references:
1893;;; (setq Info-point-loc
1894;;; (buffer-substring (match-beginning 0) (1- (match-beginning 1))))
1895 )
1866 (replace-regexp-in-string 1896 (replace-regexp-in-string
1867 "[ \n]+" " " 1897 "[ \n]+" " "
1868 (or (match-string 2) 1898 (or (match-string 2)
@@ -2327,7 +2357,7 @@ Give a blank topic name to go to the Index node itself."
2327 (if (equal Info-current-file "dir") 2357 (if (equal Info-current-file "dir")
2328 (error "The Info directory node has no index; use m to select a manual")) 2358 (error "The Info directory node has no index; use m to select a manual"))
2329 (let ((orignode Info-current-node) 2359 (let ((orignode Info-current-node)
2330 (pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^.\n]*\\)\\.[ \t]*\\([0-9]*\\)" 2360 (pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
2331 (regexp-quote topic))) 2361 (regexp-quote topic)))
2332 node 2362 node
2333 (case-fold-search t)) 2363 (case-fold-search t))
@@ -2379,7 +2409,7 @@ Give a blank topic name to go to the Index node itself."
2379 num (1- num))) 2409 num (1- num)))
2380 (Info-goto-node (nth 1 (car Info-index-alternatives))) 2410 (Info-goto-node (nth 1 (car Info-index-alternatives)))
2381 (if (> (nth 3 (car Info-index-alternatives)) 0) 2411 (if (> (nth 3 (car Info-index-alternatives)) 0)
2382 (forward-line (nth 3 (car Info-index-alternatives))) 2412 (forward-line (1- (nth 3 (car Info-index-alternatives))))
2383 (forward-line 3) ; don't search in headers 2413 (forward-line 3) ; don't search in headers
2384 (let ((name (car (car Info-index-alternatives)))) 2414 (let ((name (car (car Info-index-alternatives))))
2385 (Info-find-index-name name))) 2415 (Info-find-index-name name)))
@@ -2418,7 +2448,7 @@ Give a blank topic name to go to the Index node itself."
2418Build a menu of the possible matches." 2448Build a menu of the possible matches."
2419 (interactive "sIndex apropos: ") 2449 (interactive "sIndex apropos: ")
2420 (unless (string= string "") 2450 (unless (string= string "")
2421 (let ((pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^.]+\\)." 2451 (let ((pattern (format "\n\\* +\\([^\n]*%s[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?"
2422 (regexp-quote string))) 2452 (regexp-quote string)))
2423 (ohist Info-history) 2453 (ohist Info-history)
2424 (ohist-list Info-history-list) 2454 (ohist-list Info-history-list)
@@ -2447,9 +2477,10 @@ Build a menu of the possible matches."
2447 (goto-char (point-min)) 2477 (goto-char (point-min))
2448 (while (re-search-forward pattern nil t) 2478 (while (re-search-forward pattern nil t)
2449 (add-to-list 'matches 2479 (add-to-list 'matches
2450 (list (match-string 1) 2480 (list manual
2451 (match-string 2) 2481 (match-string-no-properties 1)
2452 manual))) 2482 (match-string-no-properties 2)
2483 (match-string-no-properties 3))))
2453 (and (setq node (Info-extract-pointer "next" t)) 2484 (and (setq node (Info-extract-pointer "next" t))
2454 (string-match "\\<Index\\>" node))) 2485 (string-match "\\<Index\\>" node)))
2455 (Info-goto-node node)))) 2486 (Info-goto-node node))))
@@ -2465,9 +2496,12 @@ Build a menu of the possible matches."
2465 (insert "\n\nFile: apropos, Node: Top, Up: (dir)\n") 2496 (insert "\n\nFile: apropos, Node: Top, Up: (dir)\n")
2466 (insert "* Menu: \nNodes whose indices contain \"" string "\"\n\n") 2497 (insert "* Menu: \nNodes whose indices contain \"" string "\"\n\n")
2467 (dolist (entry matches) 2498 (dolist (entry matches)
2468 (insert "* " (car entry) " [" (nth 2 entry) 2499 (insert "* " (nth 1 entry) " [" (nth 0 entry)
2469 "]: (" (nth 2 entry) ")" (nth 1 entry) ".\n"))) 2500 "]: (" (nth 0 entry) ")" (nth 2 entry) "."
2470 (Info-find-node "apropos" "top"))))) 2501 (if (nth 3 entry) (concat " (line " (nth 3 entry) ")") "")
2502 "\n")))
2503 (Info-find-node "apropos" "top")
2504 (setq Info-complete-cache nil)))))
2471 2505
2472(defun Info-undefined () 2506(defun Info-undefined ()
2473 "Make command be undefined in Info." 2507 "Make command be undefined in Info."
@@ -2583,21 +2617,16 @@ if point is in a menu item description, follow that menu item."
2583 (browse-url (browse-url-url-at-point))) 2617 (browse-url (browse-url-url-at-point)))
2584 ((setq node (Info-get-token (point) "\\*note[ \n\t]+" 2618 ((setq node (Info-get-token (point) "\\*note[ \n\t]+"
2585 "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?")) 2619 "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?"))
2586;;; (or (match-string 2)
2587;;; (setq Info-reference-name
2588;;; (replace-regexp-in-string
2589;;; "[ \n\t]+" " " (match-string-no-properties 1))))
2590 (Info-follow-reference node fork)) 2620 (Info-follow-reference node fork))
2591 ;; menu item: node name 2621 ;; menu item: node name
2592 ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::")) 2622 ((setq node (Info-get-token (point) "\\* +" "\\* +\\([^:]*\\)::"))
2593 (Info-goto-node node fork)) 2623 (Info-goto-node node fork))
2594 ;; menu item: index entry 2624 ;; menu item: node name or index entry
2595 ((Info-get-token (point) "\\* +" "\\* +\\(.*\\): ") 2625 ((Info-get-token (point) "\\* +" "\\* +\\(.*\\): ")
2596 (if (save-match-data (string-match "\\<index\\>" Info-current-node))
2597 (setq Info-reference-name (match-string-no-properties 1)))
2598 (beginning-of-line) 2626 (beginning-of-line)
2599 (forward-char 2) 2627 (forward-char 2)
2600 (setq node (Info-extract-menu-node-name)) 2628 (setq node (Info-extract-menu-node-name
2629 nil (string-match "\\<index\\>" Info-current-node)))
2601 (Info-goto-node node fork)) 2630 (Info-goto-node node fork))
2602 ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)")) 2631 ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)"))
2603 (Info-goto-node node fork)) 2632 (Info-goto-node node fork))
@@ -2847,6 +2876,7 @@ Selecting other nodes:
2847\\[Info-toc] Go to the buffer with a table of contents. 2876\\[Info-toc] Go to the buffer with a table of contents.
2848\\[Info-index] Look up a topic in this file's Index and move to that node. 2877\\[Info-index] Look up a topic in this file's Index and move to that node.
2849\\[Info-index-next] (comma) Move to the next match from a previous \\<Info-mode-map>\\[Info-index] command. 2878\\[Info-index-next] (comma) Move to the next match from a previous \\<Info-mode-map>\\[Info-index] command.
2879\\[info-apropos] Look for a string in the indices of all manuals.
2850\\[Info-top-node] Go to the Top node of this file. 2880\\[Info-top-node] Go to the Top node of this file.
2851\\[Info-final-node] Go to the final node in this file. 2881\\[Info-final-node] Go to the final node in this file.
2852\\[Info-backward-node] Go backward one node, considering all nodes as forming one sequence. 2882\\[Info-backward-node] Go backward one node, considering all nodes as forming one sequence.
@@ -2907,8 +2937,8 @@ Advanced commands:
2907 ;; This is for the sake of the invisible text we use handling titles. 2937 ;; This is for the sake of the invisible text we use handling titles.
2908 (make-local-variable 'line-move-ignore-invisible) 2938 (make-local-variable 'line-move-ignore-invisible)
2909 (setq line-move-ignore-invisible t) 2939 (setq line-move-ignore-invisible t)
2910 (make-local-variable 'desktop-buffer-misc-data-function) 2940 (make-local-variable 'desktop-save-buffer)
2911 (setq desktop-buffer-misc-data-function 'Info-desktop-buffer-misc-data) 2941 (setq desktop-save-buffer 'Info-desktop-buffer-misc-data)
2912 (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t) 2942 (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t)
2913 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) 2943 (add-hook 'change-major-mode-hook 'font-lock-defontify nil t)
2914 (Info-set-mode-line) 2944 (Info-set-mode-line)
@@ -3351,7 +3381,8 @@ Preserve text properties."
3351 (hl Info-history-list) 3381 (hl Info-history-list)
3352 res) 3382 res)
3353 (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) 3383 (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node)
3354 (setq file (match-string 1 node) 3384 (setq file (file-name-nondirectory
3385 (match-string 1 node))
3355 node (if (equal (match-string 2 node) "") 3386 node (if (equal (match-string 2 node) "")
3356 "Top" 3387 "Top"
3357 (match-string 2 node)))) 3388 (match-string 2 node))))
@@ -3451,7 +3482,8 @@ Preserve text properties."
3451 (hl Info-history-list) 3482 (hl Info-history-list)
3452 res) 3483 res)
3453 (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) 3484 (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node)
3454 (setq file (match-string 1 node) 3485 (setq file (file-name-nondirectory
3486 (match-string 1 node))
3455 node (if (equal (match-string 2 node) "") 3487 node (if (equal (match-string 2 node) "")
3456 "Top" 3488 "Top"
3457 (match-string 2 node)))) 3489 (match-string 2 node))))
@@ -3499,6 +3531,13 @@ Preserve text properties."
3499 (put-text-property (match-beginning 1) (match-end 1) 3531 (put-text-property (match-beginning 1) (match-end 1)
3500 'font-lock-face 'info-menu-header))) 3532 'font-lock-face 'info-menu-header)))
3501 3533
3534 ;; Hide index line numbers
3535 (goto-char (point-min))
3536 (when (and not-fontified-p (string-match "\\<Index\\>" Info-current-node))
3537 (while (re-search-forward "[ \t\n]*(line +[0-9]+)" nil t)
3538 (put-text-property (match-beginning 0) (match-end 0)
3539 'invisible t)))
3540
3502 ;; Fontify http and ftp references 3541 ;; Fontify http and ftp references
3503 (goto-char (point-min)) 3542 (goto-char (point-min))
3504 (when not-fontified-p 3543 (when not-fontified-p
diff --git a/lisp/log-view.el b/lisp/log-view.el
index a6f736d16f7..51ca8907db8 100644
--- a/lisp/log-view.el
+++ b/lisp/log-view.el
@@ -191,8 +191,10 @@
191 "Get the diff for several revisions. 191 "Get the diff for several revisions.
192If the point is the same as the mark, get the diff for this revision. 192If the point is the same as the mark, get the diff for this revision.
193Otherwise, get the diff between the revisions 193Otherwise, get the diff between the revisions
194 were the region starts and ends." 194were the region starts and ends."
195 (interactive "r") 195 (interactive
196 (list (if mark-active (region-beginning) (point))
197 (if mark-active (region-end) (point))))
196 (let ((fr (log-view-current-tag beg)) 198 (let ((fr (log-view-current-tag beg))
197 (to (log-view-current-tag end))) 199 (to (log-view-current-tag end)))
198 (when (string-equal fr to) 200 (when (string-equal fr to)
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index a8a78abf01b..bdf04be519a 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -227,7 +227,9 @@ and the value of the environment variable MAIL overrides it)."
227 227
228;;;###autoload 228;;;###autoload
229(defcustom rmail-mail-new-frame nil 229(defcustom rmail-mail-new-frame nil
230 "*Non-nil means Rmail makes a new frame for composing outgoing mail." 230 "*Non-nil means Rmail makes a new frame for composing outgoing mail.
231This is handy if you want to preserve the window configuration of
232the frame where you have the RMAIL buffer displayed."
231 :type 'boolean 233 :type 'boolean
232 :group 'rmail-reply) 234 :group 'rmail-reply)
233 235
@@ -1137,7 +1139,9 @@ Instead, these commands are available:
1137 (make-local-variable 'kill-buffer-hook) 1139 (make-local-variable 'kill-buffer-hook)
1138 (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary) 1140 (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary)
1139 (make-local-variable 'file-precious-flag) 1141 (make-local-variable 'file-precious-flag)
1140 (setq file-precious-flag t)) 1142 (setq file-precious-flag t)
1143 (make-local-variable 'desktop-save-buffer)
1144 (setq desktop-save-buffer t))
1141 1145
1142;; Handle M-x revert-buffer done in an rmail-mode buffer. 1146;; Handle M-x revert-buffer done in an rmail-mode buffer.
1143(defun rmail-revert (arg noconfirm) 1147(defun rmail-revert (arg noconfirm)
@@ -1666,7 +1670,15 @@ It returns t if it got any new messages."
1666(defun rmail-decode-region (from to coding) 1670(defun rmail-decode-region (from to coding)
1667 (if (or (not coding) (not (coding-system-p coding))) 1671 (if (or (not coding) (not (coding-system-p coding)))
1668 (setq coding 'undecided)) 1672 (setq coding 'undecided))
1669 (decode-coding-region from to coding)) 1673 ;; Use -dos decoding, to remove ^M characters left from base64 or
1674 ;; rogue qp-encoded text.
1675 (decode-coding-region from to
1676 (coding-system-change-eol-conversion coding 1))
1677 ;; Don't reveal the fact we used -dos decoding, as users generally
1678 ;; will not expect the RMAIL buffer to use DOS EOL format.
1679 (setq buffer-file-coding-system
1680 (setq last-coding-system-used
1681 (coding-system-change-eol-conversion coding 0))))
1670 1682
1671;; the rmail-break-forwarded-messages feature is not implemented 1683;; the rmail-break-forwarded-messages feature is not implemented
1672(defun rmail-convert-to-babyl-format () 1684(defun rmail-convert-to-babyl-format ()
@@ -1751,9 +1763,6 @@ It returns t if it got any new messages."
1751 (error nil)) 1763 (error nil))
1752 ;; Change "base64" to "8bit", to reflect the 1764 ;; Change "base64" to "8bit", to reflect the
1753 ;; decoding we just did. 1765 ;; decoding we just did.
1754 (goto-char (1+ header-end))
1755 (while (search-forward "\r\n" (point-max) t)
1756 (replace-match "\n"))
1757 (goto-char base64-header-field-end) 1766 (goto-char base64-header-field-end)
1758 (delete-region (point) (search-backward ":")) 1767 (delete-region (point) (search-backward ":"))
1759 (insert ": 8bit")))) 1768 (insert ": 8bit"))))
@@ -1901,9 +1910,6 @@ It returns t if it got any new messages."
1901 (point))) 1910 (point)))
1902 t) 1911 t)
1903 (error nil)) 1912 (error nil))
1904 (goto-char header-end)
1905 (while (search-forward "\r\n" (point-max) t)
1906 (replace-match "\n"))
1907 ;; Change "base64" to "8bit", to reflect the 1913 ;; Change "base64" to "8bit", to reflect the
1908 ;; decoding we just did. 1914 ;; decoding we just did.
1909 (goto-char base64-header-field-end) 1915 (goto-char base64-header-field-end)
@@ -3167,7 +3173,7 @@ See also user-option `rmail-confirm-expunge'."
3167 (compose-mail to subject others 3173 (compose-mail to subject others
3168 noerase nil 3174 noerase nil
3169 yank-action sendactions) 3175 yank-action sendactions)
3170 (if (and (display-multi-frame-p) rmail-mail-new-frame) 3176 (if rmail-mail-new-frame
3171 (prog1 3177 (prog1
3172 (compose-mail to subject others 3178 (compose-mail to subject others
3173 noerase 'switch-to-buffer-other-frame 3179 noerase 'switch-to-buffer-other-frame
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 932f52204c5..d5a85741371 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -714,7 +714,12 @@ Prefix arg means don't delete this window."
714 (if (and (or (window-dedicated-p (frame-selected-window)) 714 (if (and (or (window-dedicated-p (frame-selected-window))
715 (cdr (assq 'mail-dedicated-frame (frame-parameters)))) 715 (cdr (assq 'mail-dedicated-frame (frame-parameters))))
716 (not (null (delq (selected-frame) (visible-frame-list))))) 716 (not (null (delq (selected-frame) (visible-frame-list)))))
717 (delete-frame (selected-frame)) 717 (progn
718 (if (display-multi-frame-p)
719 (delete-frame (selected-frame))
720 ;; The previous frame is where normally they have the
721 ;; RMAIL buffer displayed.
722 (other-frame -1)))
718 (let (rmail-flag summary-buffer) 723 (let (rmail-flag summary-buffer)
719 (and (not arg) 724 (and (not arg)
720 (not (one-window-p)) 725 (not (one-window-p))
diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog
index 92c2600560f..6eb2c1bc2ec 100644
--- a/lisp/mh-e/ChangeLog
+++ b/lisp/mh-e/ChangeLog
@@ -1,3 +1,6 @@
12004-04-26 Lars Hansen <larsh@math.ku.dk>
2 * mh-e.el (mh-folder-mode): Bind desktop-save-buffer to t.
3
12003-04-24 Bill Wohler <wohler@newt.com> 42003-04-24 Bill Wohler <wohler@newt.com>
2 5
3 * Released MH-E version 7.3. 6 * Released MH-E version 7.3.
@@ -47,6 +50,10 @@
47 runs checkdoc and lm-verify which is useful before releasing the 50 runs checkdoc and lm-verify which is useful before releasing the
48 software. It can and should be expanded to do real unit tests. 51 software. It can and should be expanded to do real unit tests.
49 52
532004-04-22 Lars Hansen <larsh@math.ku.dk>
54
55 * mh-e.el (mh-restore-desktop-buffer): Delete with-no-warnings.
56
502003-04-22 Mark D Baushke <mdb@gnu.org> 572003-04-22 Mark D Baushke <mdb@gnu.org>
51 58
52 * mh-alias.el: Update Copyright. 59 * mh-alias.el: Update Copyright.
@@ -71,6 +78,11 @@
71 Emacs. 78 Emacs.
72 (mh-exec-cmd-error): Add a comment, so that we change it later on. 79 (mh-exec-cmd-error): Add a comment, so that we change it later on.
73 80
812004-04-21 Lars Hansen <larsh@math.ku.dk>
82
83 * mh-e.el (mh-restore-desktop-buffer): Move from
84 desktop.el. Add Parameters.
85
742003-04-18 Steve Youngs <youngs@xemacs.org> 862003-04-18 Steve Youngs <youngs@xemacs.org>
75 87
76 * mh-xemacs-icons.el (mh-xemacs-icons): Provide 'mh-xemacs-icons' 88 * mh-xemacs-icons.el (mh-xemacs-icons): Provide 'mh-xemacs-icons'
diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el
index ca81350ba57..344a67f5725 100644
--- a/lisp/mh-e/mh-e.el
+++ b/lisp/mh-e/mh-e.el
@@ -1548,6 +1548,8 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run.
1548 1548
1549 (make-local-variable 'font-lock-defaults) 1549 (make-local-variable 'font-lock-defaults)
1550 (setq font-lock-defaults '(mh-folder-font-lock-keywords t)) 1550 (setq font-lock-defaults '(mh-folder-font-lock-keywords t))
1551 (make-local-variable 'desktop-save-buffer)
1552 (setq desktop-save-buffer t)
1551 (mh-make-local-vars 1553 (mh-make-local-vars
1552 'mh-current-folder (buffer-name) ; Name of folder, a string 1554 'mh-current-folder (buffer-name) ; Name of folder, a string
1553 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs 1555 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
diff --git a/lisp/paren.el b/lisp/paren.el
index ab3efe10ba5..6c5f9dece99 100644
--- a/lisp/paren.el
+++ b/lisp/paren.el
@@ -91,6 +91,9 @@ otherwise)."
91 :group 'faces 91 :group 'faces
92 :group 'paren-showing) 92 :group 'paren-showing)
93 93
94(defvar show-paren-highlight-openparen t
95 "*Non-nil turns on openparen highlighting when matching forward.")
96
94(defvar show-paren-idle-timer nil) 97(defvar show-paren-idle-timer nil)
95 98
96;;;###autoload 99;;;###autoload
@@ -195,7 +198,7 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time."
195 ;; If matching forward, and the openparen is unbalanced, 198 ;; If matching forward, and the openparen is unbalanced,
196 ;; highlight the paren at point to indicate misbalance. 199 ;; highlight the paren at point to indicate misbalance.
197 ;; Otherwise, turn off any such highlighting. 200 ;; Otherwise, turn off any such highlighting.
198 (if (and (= dir 1) (integerp pos)) 201 (if (and (not show-paren-highlight-openparen) (= dir 1) (integerp pos))
199 (when (and show-paren-overlay-1 202 (when (and show-paren-overlay-1
200 (overlay-buffer show-paren-overlay-1)) 203 (overlay-buffer show-paren-overlay-1))
201 (delete-overlay show-paren-overlay-1)) 204 (delete-overlay show-paren-overlay-1))
diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el
index 213b68a4000..42f4c23add1 100644
--- a/lisp/pcomplete.el
+++ b/lisp/pcomplete.el
@@ -1,6 +1,6 @@
1;;; pcomplete.el --- programmable completion 1;;; pcomplete.el --- programmable completion
2 2
3;; Copyright (C) 1999, 2000, 2001, 2002 Free Sofware Foundation 3;; Copyright (C) 1999, 2000,01,02,03,04 Free Sofware Foundation
4 4
5;; Author: John Wiegley <johnw@gnu.org> 5;; Author: John Wiegley <johnw@gnu.org>
6;; Keywords: processes abbrev 6;; Keywords: processes abbrev
@@ -505,7 +505,7 @@ See the documentation for `pcomplete-arg'."
505 505
506(defsubst pcomplete-actual-arg (&optional index offset) 506(defsubst pcomplete-actual-arg (&optional index offset)
507 "Return the actual text representation of the last argument. 507 "Return the actual text representation of the last argument.
508This different from `pcomplete-arg', which returns the textual value 508This is different from `pcomplete-arg', which returns the textual value
509that the last argument evaluated to. This function returns what the 509that the last argument evaluated to. This function returns what the
510user actually typed in." 510user actually typed in."
511 (buffer-substring (pcomplete-begin index offset) (point))) 511 (buffer-substring (pcomplete-begin index offset) (point)))
@@ -531,7 +531,7 @@ user actually typed in."
531 (throw 'pcompleted nil)))) 531 (throw 'pcompleted nil))))
532 532
533(defun pcomplete-match-string (which &optional index offset) 533(defun pcomplete-match-string (which &optional index offset)
534 "Like `string-match', but on the current completion argument." 534 "Like `match-string', but on the current completion argument."
535 (let ((arg (pcomplete-arg (or index 1) offset))) 535 (let ((arg (pcomplete-arg (or index 1) offset)))
536 (if arg 536 (if arg
537 (match-string which arg) 537 (match-string which arg)
@@ -583,8 +583,8 @@ user actually typed in."
583(defun pcomplete-comint-setup (completef-sym) 583(defun pcomplete-comint-setup (completef-sym)
584 "Setup a comint buffer to use pcomplete. 584 "Setup a comint buffer to use pcomplete.
585COMPLETEF-SYM should be the symbol where the 585COMPLETEF-SYM should be the symbol where the
586dynamic-complete-functions are kept. For comint mode itself, this is 586dynamic-complete-functions are kept. For comint mode itself,
587`comint-dynamic-complete-functions'." 587this is `comint-dynamic-complete-functions'."
588 (set (make-local-variable 'pcomplete-parse-arguments-function) 588 (set (make-local-variable 'pcomplete-parse-arguments-function)
589 'pcomplete-parse-comint-arguments) 589 'pcomplete-parse-comint-arguments)
590 (make-local-variable completef-sym) 590 (make-local-variable completef-sym)
@@ -709,7 +709,7 @@ match (files not matching the REGEXP will be excluded).
709If PREDICATE is non-nil, it will also be used to refine the match 709If PREDICATE is non-nil, it will also be used to refine the match
710\(files for which the PREDICATE returns nil will be excluded). 710\(files for which the PREDICATE returns nil will be excluded).
711If no directory information can be extracted from the completed 711If no directory information can be extracted from the completed
712component, DEFAULT-DIRECTORY is used as the basis for completion." 712component, `default-directory' is used as the basis for completion."
713 (let* ((name (substitute-env-vars pcomplete-stub)) 713 (let* ((name (substitute-env-vars pcomplete-stub))
714 (default-directory (expand-file-name 714 (default-directory (expand-file-name
715 (or (file-name-directory name) 715 (or (file-name-directory name)
@@ -809,11 +809,10 @@ component, DEFAULT-DIRECTORY is used as the basis for completion."
809(defun pcomplete-opt (options &optional prefix no-ganging args-follow) 809(defun pcomplete-opt (options &optional prefix no-ganging args-follow)
810 "Complete a set of OPTIONS, each beginning with PREFIX (?- by default). 810 "Complete a set of OPTIONS, each beginning with PREFIX (?- by default).
811PREFIX may be t, in which case no PREFIX character is necessary. 811PREFIX may be t, in which case no PREFIX character is necessary.
812If REQUIRED is non-nil, the options must be present. 812If NO-GANGING is non-nil, each option is separate (-xy is not allowed).
813If NO-GANGING is non-nil, each option is separate. -xy is not allowed. 813If ARGS-FOLLOW is non-nil, then options which take arguments may have
814If ARGS-FOLLOW is non-nil, then options which arguments which take may 814the argument appear after a ganged set of options. This is how tar
815have the argument appear after a ganged set of options. This is how 815behaves, for example."
816tar behaves, for example."
817 (if (and (= pcomplete-index pcomplete-last) 816 (if (and (= pcomplete-index pcomplete-last)
818 (string= (pcomplete-arg) "-")) 817 (string= (pcomplete-arg) "-"))
819 (let ((len (length options)) 818 (let ((len (length options))
@@ -864,7 +863,7 @@ tar behaves, for example."
864 (setq index (1+ index)))))))) 863 (setq index (1+ index))))))))
865 864
866(defun pcomplete--here (&optional form stub paring form-only) 865(defun pcomplete--here (&optional form stub paring form-only)
867 "Complete aganst the current argument, if at the end. 866 "Complete against the current argument, if at the end.
868See the documentation for `pcomplete-here'." 867See the documentation for `pcomplete-here'."
869 (if (< pcomplete-index pcomplete-last) 868 (if (< pcomplete-index pcomplete-last)
870 (progn 869 (progn
@@ -893,7 +892,7 @@ See the documentation for `pcomplete-here'."
893 (throw 'pcomplete-completions (eval form)))) 892 (throw 'pcomplete-completions (eval form))))
894 893
895(defmacro pcomplete-here (&optional form stub paring form-only) 894(defmacro pcomplete-here (&optional form stub paring form-only)
896 "Complete aganst the current argument, if at the end. 895 "Complete against the current argument, if at the end.
897If completion is to be done here, evaluate FORM to generate the list 896If completion is to be done here, evaluate FORM to generate the list
898of strings which will be used for completion purposes. If STUB is a 897of strings which will be used for completion purposes. If STUB is a
899string, use it as the completion stub instead of the default (which is 898string, use it as the completion stub instead of the default (which is
@@ -913,10 +912,11 @@ always for the sake of efficiency.
913 912
914If PARING is nil, this argument will be pared against previous 913If PARING is nil, this argument will be pared against previous
915arguments using the function `file-truename' to normalize them. 914arguments using the function `file-truename' to normalize them.
916PARING may be a function, in which case that function is for 915PARING may be a function, in which case that function is used for
917normalization. If PARING is the value t, the argument dealt with by 916normalization. If PARING is t, the argument dealt with by this
918this call will not participate in argument paring. If it the integer 917call will not participate in argument paring. If it is the
9190, all previous arguments that have been seen will be cleared. 918integer 0, all previous arguments that have been seen will be
919cleared.
920 920
921If FORM-ONLY is non-nil, only the result of FORM will be used to 921If FORM-ONLY is non-nil, only the result of FORM will be used to
922generate the completions list. This means that the hook 922generate the completions list. This means that the hook
@@ -1129,10 +1129,7 @@ See also `pcomplete-filename'."
1129 1129
1130(defun pcomplete--help () 1130(defun pcomplete--help ()
1131 "Produce context-sensitive help for the current argument. 1131 "Produce context-sensitive help for the current argument.
1132If specific documentation can't be given, be generic. 1132If specific documentation can't be given, be generic."
1133INFODOC specifies the Info node to goto. DOCUMENTATION is a sexp
1134which will produce documentation for the argument (it is responsible
1135for displaying in its own buffer)."
1136 (if (and pcomplete-help 1133 (if (and pcomplete-help
1137 (or (and (stringp pcomplete-help) 1134 (or (and (stringp pcomplete-help)
1138 (fboundp 'Info-goto-node)) 1135 (fboundp 'Info-goto-node))
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 9aaa992ca76..2c8ead87000 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -184,7 +184,7 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1))
184 184
185 ;; fixme: should be `mips' 185 ;; fixme: should be `mips'
186 (irix 186 (irix
187 "^[-[:alnum:]_/]+: \\(?:[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\ 187 "^[-[:alnum:]_/]+: \\(?:[sS]evere\\|[eE]rror\\|[wW]arnin\\(g\\)\\|[iI]nf\\(o\\)\\)[0-9 ]*:\
188 \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2)) 188 \\([^,\" \n\t]+\\)\\(?:, line\\|:\\) \\([0-9]+\\):" 3 4 nil (1 . 2))
189 189
190 (java 190 (java
@@ -587,10 +587,9 @@ Faces `compilation-error-face', `compilation-warning-face',
587 "Get the meta-info that will be added as text-properties. 587 "Get the meta-info that will be added as text-properties.
588LINE, END-LINE, COL, END-COL are integers or nil. 588LINE, END-LINE, COL, END-COL are integers or nil.
589TYPE can be 0, 1, or 2. 589TYPE can be 0, 1, or 2.
590FILE should be (FILENAME . DIRNAME) or nil." 590FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil."
591 (unless file (setq file '("*unknown*"))) 591 (unless file (setq file '("*unknown*")))
592 (setq file (or (gethash file compilation-locs) 592 (setq file (compilation-get-file-structure file fmt))
593 (puthash file (list file fmt) compilation-locs)))
594 ;; Get first already existing marker (if any has one, all have one). 593 ;; Get first already existing marker (if any has one, all have one).
595 ;; Do this first, as the compilation-assq`s may create new nodes. 594 ;; Do this first, as the compilation-assq`s may create new nodes.
596 (let* ((marker-line (car (cddr file))) ; a line structure 595 (let* ((marker-line (car (cddr file))) ; a line structure
@@ -599,19 +598,17 @@ FILE should be (FILENAME . DIRNAME) or nil."
599 end-marker loc end-loc) 598 end-marker loc end-loc)
600 (if (not (and marker (marker-buffer marker))) 599 (if (not (and marker (marker-buffer marker)))
601 (setq marker) ; no valid marker for this file 600 (setq marker) ; no valid marker for this file
602 (setq loc (or line 1) ; normalize no linenumber to line 1 601 (setq loc (or line 1)) ; normalize no linenumber to line 1
603 marker-line) 602 (catch 'marker ; find nearest loc, at least one exists
604 (catch 'marker ; find nearest loc, at least one exists 603 (dolist (x (nthcdr 3 file)) ; loop over remaining lines
605 (dolist (x (cddr file)) ; loop over lines 604 (if (> (car x) loc) ; still bigger
606 (if (> (or (car x) 1) loc) ; still bigger
607 (setq marker-line x) 605 (setq marker-line x)
608 (if (or (not marker-line) ; first in list 606 (if (> (- (or (car marker-line) 1) loc)
609 (> (- (or (car marker-line) 1) loc) 607 (- loc (car x))) ; current line is nearer
610 (- loc (or (car x) 1)))) ; current line is nearer
611 (setq marker-line x)) 608 (setq marker-line x))
612 (throw 'marker t)))) 609 (throw 'marker t))))
613 (setq marker (nth 3 (cadr marker-line)) 610 (setq marker (nth 3 (cadr marker-line))
614 marker-line (car marker-line)) 611 marker-line (or (car marker-line) 1))
615 (with-current-buffer (marker-buffer marker) 612 (with-current-buffer (marker-buffer marker)
616 (save-restriction 613 (save-restriction
617 (widen) 614 (widen)
@@ -1451,6 +1448,7 @@ Use this command in a compilation log buffer. Sets the mark at point there."
1451 1448
1452(defun compilation-fake-loc (marker file &optional line col) 1449(defun compilation-fake-loc (marker file &optional line col)
1453 "Preassociate MARKER with FILE. 1450 "Preassociate MARKER with FILE.
1451FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
1454This is useful when you compile temporary files, but want 1452This is useful when you compile temporary files, but want
1455automatic translation of the messages to the real buffer from 1453automatic translation of the messages to the real buffer from
1456which the temporary file came. This only works if done before a 1454which the temporary file came. This only works if done before a
@@ -1466,13 +1464,12 @@ header with variable assignments and a code region), you must
1466call this several times, once each for the last line of one 1464call this several times, once each for the last line of one
1467region and the first line of the next region." 1465region and the first line of the next region."
1468 (or (consp file) (setq file (list file))) 1466 (or (consp file) (setq file (list file)))
1469 (setq file (or (gethash file compilation-locs) 1467 (setq file (compilation-get-file-structure file))
1470 (puthash file (list file nil) compilation-locs)))
1471 (let ((loc (compilation-assq (or line 1) (cdr file)))) 1468 (let ((loc (compilation-assq (or line 1) (cdr file))))
1472 (setq loc (compilation-assq col loc)) 1469 (setq loc (compilation-assq col loc))
1473 (if (cdr loc) 1470 (if (cdr loc)
1474 (setcdr (cddr loc) (list marker)) 1471 (setcdr (cddr loc) (list marker))
1475 (setcdr loc (list (or line 1) file marker))) 1472 (setcdr loc (list line file marker)))
1476 loc)) 1473 loc))
1477 1474
1478(defcustom compilation-context-lines next-screen-context-lines 1475(defcustom compilation-context-lines next-screen-context-lines
@@ -1598,67 +1595,58 @@ Pop up the buffer containing MARKER and scroll to MARKER if we ask the user."
1598 (overlays-in (point-min) (point-max))) 1595 (overlays-in (point-min) (point-max)))
1599 buffer))) 1596 buffer)))
1600 1597
1601(defun compilation-normalize-filename (filename) 1598(defun compilation-get-file-structure (file &optional fmt)
1602 "Convert FILENAME string found in an error message to make it usable." 1599 "Retrieve FILE's file-structure or create a new one.
1603 1600FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."
1604 ;; Check for a comint-file-name-prefix and prepend it if 1601
1605 ;; appropriate. (This is very useful for 1602 (or (gethash file compilation-locs)
1606 ;; compilation-minor-mode in an rlogin-mode buffer.) 1603 ;; File was not previously encountered, at least not in the form passed.
1607 (and (boundp 'comint-file-name-prefix) 1604 ;; Let's normalize it and look again.
1608 ;; If file name is relative, default-directory will 1605 (let ((filename (car file))
1609 ;; already contain the comint-file-name-prefix (done 1606 (default-directory (if (cdr file)
1610 ;; by compile-abbreviate-directory). 1607 (file-truename (cdr file))
1611 (file-name-absolute-p filename) 1608 default-directory)))
1612 (setq filename 1609
1613 (concat (with-no-warnings 'comint-file-name-prefix) filename))) 1610 ;; Check for a comint-file-name-prefix and prepend it if appropriate.
1614 1611 ;; (This is very useful for compilation-minor-mode in an rlogin-mode
1615 ;; If compilation-parse-errors-filename-function is 1612 ;; buffer.)
1616 ;; defined, use it to process the filename. 1613 (if (boundp 'comint-file-name-prefix)
1617 (when compilation-parse-errors-filename-function 1614 (if (file-name-absolute-p filename)
1618 (setq filename 1615 (setq filename
1619 (funcall compilation-parse-errors-filename-function 1616 (concat (with-no-warnings comint-file-name-prefix) filename))
1620 filename))) 1617 (setq default-directory
1621 1618 (file-truename
1622 ;; Some compilers (e.g. Sun's java compiler, reportedly) 1619 (concat (with-no-warnings comint-file-name-prefix) default-directory)))))
1623 ;; produce bogus file names like "./bar//foo.c" for file 1620
1624 ;; "bar/foo.c"; expand-file-name will collapse these into 1621 ;; If compilation-parse-errors-filename-function is
1625 ;; "/foo.c" and fail to find the appropriate file. So we 1622 ;; defined, use it to process the filename.
1626 ;; look for doubled slashes in the file name and fix them 1623 (when compilation-parse-errors-filename-function
1627 ;; up in the buffer. 1624 (setq filename
1628 (setq filename (command-line-normalize-file-name filename))) 1625 (funcall compilation-parse-errors-filename-function
1629 1626 filename)))
1630 1627
1631;; If directory DIR is a subdir of ORIG or of ORIG's parent, 1628 ;; Some compilers (e.g. Sun's java compiler, reportedly) produce bogus
1632;; return a relative name for it starting from ORIG or its parent. 1629 ;; file names like "./bar//foo.c" for file "bar/foo.c";
1633;; ORIG-EXPANDED is an expanded version of ORIG. 1630 ;; expand-file-name will collapse these into "/foo.c" and fail to find
1634;; PARENT-EXPANDED is an expanded version of ORIG's parent. 1631 ;; the appropriate file. So we look for doubled slashes in the file
1635;; Those two args could be computed here, but we run faster by 1632 ;; name and fix them.
1636;; having the caller compute them just once. 1633 (setq filename (command-line-normalize-file-name filename))
1637(defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded) 1634
1638 ;; Apply canonical abbreviations to DIR first thing. 1635 ;; Now eliminate any "..", because find-file would get them wrong.
1639 ;; Those abbreviations are already done in the other arguments passed. 1636 ;; Make relative and absolute filenames, with or without links, the
1640 (setq dir (abbreviate-file-name dir)) 1637 ;; same.
1641 1638 (setq filename
1642 ;; Check for a comint-file-name-prefix and prepend it if appropriate. 1639 (list (abbreviate-file-name
1643 ;; (This is very useful for compilation-minor-mode in an rlogin-mode 1640 (file-truename (if (cdr file)
1644 ;; buffer.) 1641 (expand-file-name filename)
1645 (if (boundp 'comint-file-name-prefix) 1642 filename)))))
1646 (setq dir (concat comint-file-name-prefix dir))) 1643
1647 1644 ;; Store it for the possibly unnormalized name
1648 (if (and (> (length dir) (length orig-expanded)) 1645 (puthash file
1649 (string= orig-expanded 1646 ;; Retrieve or create file-structure for normalized name
1650 (substring dir 0 (length orig-expanded)))) 1647 (or (gethash filename compilation-locs)
1651 (setq dir 1648 (puthash filename (list filename fmt) compilation-locs))
1652 (concat orig 1649 compilation-locs))))
1653 (substring dir (length orig-expanded)))))
1654 (if (and (> (length dir) (length parent-expanded))
1655 (string= parent-expanded
1656 (substring dir 0 (length parent-expanded))))
1657 (setq dir
1658 (concat (file-name-directory
1659 (directory-file-name orig))
1660 (substring dir (length parent-expanded)))))
1661 dir)
1662 1650
1663(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$") 1651(add-to-list 'debug-ignored-errors "^No more [-a-z ]+s yet$")
1664 1652
diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el
index 4627f2ac639..bdf8c93f900 100644
--- a/lisp/progmodes/gud.el
+++ b/lisp/progmodes/gud.el
@@ -1401,7 +1401,7 @@ and source-file directory for your debugger."
1401 1401
1402 output)) 1402 output))
1403 1403
1404(defcustom gud-pdb-command-name "pdb" 1404(defcustom gud-pdb-command-name "pydb"
1405 "File name for executing the Python debugger. 1405 "File name for executing the Python debugger.
1406This should be an executable on your path, or an absolute file name." 1406This should be an executable on your path, or an absolute file name."
1407 :type 'string 1407 :type 'string
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
index 5635a1b17f7..f47ca3a73d4 100644
--- a/lisp/progmodes/sh-script.el
+++ b/lisp/progmodes/sh-script.el
@@ -648,7 +648,7 @@ implemented as aliases. See `sh-feature'."
648 648
649 (rc "else") 649 (rc "else")
650 650
651 (sh "do" "elif" "else" "if" "then" "trap" "type" "until" "while")) 651 (sh "!" "do" "elif" "else" "if" "then" "trap" "type" "until" "while"))
652 "*List of keywords that may be immediately followed by a builtin or keyword. 652 "*List of keywords that may be immediately followed by a builtin or keyword.
653Given some confusion between keywords and builtins depending on shell and 653Given some confusion between keywords and builtins depending on shell and
654system, the distinction here has been based on whether they influence the 654system, the distinction here has been based on whether they influence the
diff --git a/lisp/simple.el b/lisp/simple.el
index 269b78e497a..4f7786ef9a4 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2152,7 +2152,7 @@ visual feedback indicating the extent of the region being copied."
2152 ;; Swap point and mark. 2152 ;; Swap point and mark.
2153 (set-marker (mark-marker) (point) (current-buffer)) 2153 (set-marker (mark-marker) (point) (current-buffer))
2154 (goto-char other-end) 2154 (goto-char other-end)
2155 (sit-for 1) 2155 (sit-for blink-matching-delay)
2156 ;; Swap back. 2156 ;; Swap back.
2157 (set-marker (mark-marker) other-end (current-buffer)) 2157 (set-marker (mark-marker) other-end (current-buffer))
2158 (goto-char opoint) 2158 (goto-char opoint)
@@ -4262,7 +4262,10 @@ The completion list buffer is available as the value of `standard-output'.")
4262 4262
4263(defface completions-common-part 4263(defface completions-common-part
4264 '((t (:inherit default))) 4264 '((t (:inherit default)))
4265 "Face put on the common prefix substring in completions in *Completions* buffer." 4265 "Face put on the common prefix substring in completions in *Completions* buffer.
4266The idea of `completions-common-part' is that you can use it to
4267make the common parts less visible than normal, so that the rest
4268of the differing parts is, by contrast, slightly highlighted."
4266 :group 'completion) 4269 :group 'completion)
4267 4270
4268(defun completion-setup-function () 4271(defun completion-setup-function ()
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
index 0497a823049..b3c69ca657f 100644
--- a/lisp/textmodes/picture.el
+++ b/lisp/textmodes/picture.el
@@ -636,7 +636,15 @@ Leaves the region surrounding the rectangle."
636 (define-key picture-mode-map "\C-c`" 'picture-movement-nw) 636 (define-key picture-mode-map "\C-c`" 'picture-movement-nw)
637 (define-key picture-mode-map "\C-c'" 'picture-movement-ne) 637 (define-key picture-mode-map "\C-c'" 'picture-movement-ne)
638 (define-key picture-mode-map "\C-c/" 'picture-movement-sw) 638 (define-key picture-mode-map "\C-c/" 'picture-movement-sw)
639 (define-key picture-mode-map "\C-c\\" 'picture-movement-se))) 639 (define-key picture-mode-map "\C-c\\" 'picture-movement-se)
640 (define-key picture-mode-map [(control ?c) left] 'picture-movement-left)
641 (define-key picture-mode-map [(control ?c) right] 'picture-movement-right)
642 (define-key picture-mode-map [(control ?c) up] 'picture-movement-up)
643 (define-key picture-mode-map [(control ?c) down] 'picture-movement-down)
644 (define-key picture-mode-map [(control ?c) home] 'picture-movement-nw)
645 (define-key picture-mode-map [(control ?c) prior] 'picture-movement-ne)
646 (define-key picture-mode-map [(control ?c) end] 'picture-movement-sw)
647 (define-key picture-mode-map [(control ?c) next] 'picture-movement-se)))
640 648
641(defcustom picture-mode-hook nil 649(defcustom picture-mode-hook nil
642 "If non-nil, its value is called on entry to Picture mode. 650 "If non-nil, its value is called on entry to Picture mode.
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
index 32908a26afa..3f5a46c5bea 100644
--- a/lisp/vc-hooks.el
+++ b/lisp/vc-hooks.el
@@ -44,8 +44,8 @@
44 "set `vc-handled-backends' to nil to disable VC.") 44 "set `vc-handled-backends' to nil to disable VC.")
45 45
46(defvar vc-master-templates ()) 46(defvar vc-master-templates ())
47(make-obsolete-variable 'vc-master-templates 47(make-obsolete-variable 'vc-master-templates
48 "to define master templates for a given BACKEND, use 48 "to define master templates for a given BACKEND, use
49vc-BACKEND-master-templates. To enable or disable VC for a given 49vc-BACKEND-master-templates. To enable or disable VC for a given
50BACKEND, use `vc-handled-backends'.") 50BACKEND, use `vc-handled-backends'.")
51 51
@@ -474,8 +474,8 @@ Return non-nil if FILE is unchanged."
474 (indirect-function 474 (indirect-function
475 (vc-find-backend-function (vc-backend file) 475 (vc-find-backend-function (vc-backend file)
476 'diff)))) 476 'diff))))
477 (not (eq (caddr err) 5))) 477 (not (eq (caddr err) 4)))
478 (signal 'wrong-number-of-arguments err) 478 (signal (car err) (cdr err))
479 (vc-call diff file)))))) 479 (vc-call diff file))))))
480 480
481(defun vc-workfile-version (file) 481(defun vc-workfile-version (file)
diff --git a/lisp/vc.el b/lisp/vc.el
index ba1972a0d6a..1b4e2409550 100644
--- a/lisp/vc.el
+++ b/lisp/vc.el
@@ -2357,11 +2357,11 @@ If FOCUS-REV is non-nil, leave the point at that revision."
2357 ;; without the optional buffer argument (for backward compatibility). 2357 ;; without the optional buffer argument (for backward compatibility).
2358 ;; Otherwise, resignal. 2358 ;; Otherwise, resignal.
2359 (if (or (not (eq (cadr err) 2359 (if (or (not (eq (cadr err)
2360 (indirect-function 2360 (indirect-function
2361 (vc-find-backend-function (vc-backend file) 2361 (vc-find-backend-function (vc-backend file)
2362 'print-log)))) 2362 'print-log))))
2363 (not (eq (caddr err) 2))) 2363 (not (eq (caddr err) 2)))
2364 (signal 'wrong-number-of-arguments err) 2364 (signal (car err) (cdr err))
2365 ;; for backward compatibility 2365 ;; for backward compatibility
2366 (vc-call print-log file) 2366 (vc-call print-log file)
2367 (set-buffer "*vc*")))) 2367 (set-buffer "*vc*"))))
diff --git a/lisp/wdired.el b/lisp/wdired.el
new file mode 100644
index 00000000000..a8c36c2066f
--- /dev/null
+++ b/lisp/wdired.el
@@ -0,0 +1,872 @@
1;;; wdired.el --- Rename files editing their names in dired buffers
2
3;; Copyright (C) 2001, 2004 Free Software Foundation, Inc.
4
5;; Filename: wdired.el
6;; Author: Juan León Lahoz García <juan-leon.lahoz@tecsidel.es>
7;; Version: 1.91
8;; Keywords: dired, environment, files, renaming
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software; you can redistribute it and/or
13;; modify it under the terms of the GNU General Public License as
14;; published by the Free Software Foundation; either version 2, or (at
15;; your option) any later version.
16
17;; This program is distributed in the hope that it will be useful, but
18;; WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20;; General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs; see the file COPYING. If not, write to the
24;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
25;; Boston, MA 02111-1307, USA.
26
27;;; Commentary:
28
29;; wdired.el (the "w" is for writable) provides an alternative way of
30;; renaming files.
31;;
32;; Have you ever wished to use C-x r t (string-rectangle), M-%
33;; (query-replace), M-c (capitalize-word), etc. to change the name of
34;; the files in a "dired" buffer? Now you can do this. All the power
35;; of emacs commands are available to renaming files!
36;;
37;; This package provides a function that makes the filenames of a a
38;; dired buffer editable, by changing the buffer mode (which inhibits
39;; all of the commands of dired mode). Here you can edit the names of
40;; one or more files and directories, and when you press C-c C-c, the
41;; renaming takes effect and you are back to dired mode.
42;;
43;; Another things you can do with wdired:
44;;
45;; - To move files to another directory (by typing their path,
46;; absolute or relative, as a part of the new filename).
47;;
48;; - To change the target of symbolic links.
49;;
50;; - To change the permission bits of the filenames (in systems with a
51;; working unix-alike `dired-chmod-program'). See and customize the
52;; variable `wdired-allow-to-change-permissions'. To change a single
53;; char (toggling between its two more usual values) you can press
54;; the space bar over it or left-click the mouse. To set any char to
55;; an specific value (this includes the SUID, SGID and STI bits) you
56;; can use the key labeled as the letter you want. Please note that
57;; permissions of the links cannot be changed in that way, because
58;; the change would affect to their targets, and this would not be
59;; WYSIWYG :-).
60;;
61;; - To mark files for deletion, by deleting their whole filename.
62;;
63;; I do not have a URL to hang wdired, but you can use the one below
64;; to find the latest version:
65;;
66;; http://groups.google.com/groups?as_ugroup=gnu.emacs.sources&as_q=wdired
67
68;;; Installation:
69
70;; Add this file (byte-compiling it is recommended) to your load-path.
71;; Then add one of these set of lines (or similar ones) to your config:
72;;
73;; This is the easy way:
74;;
75;; (require 'wdired)
76;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
77;;
78;; This is recommended way for faster emacs startup time and lower
79;; memory consumption, but remind to add these lines before dired.el
80;; gets loaded (i.e., near the beginning of your .emacs file):
81;;
82;; (autoload 'wdired-change-to-wdired-mode "wdired")
83;; (add-hook 'dired-load-hook
84;; '(lambda ()
85;; (define-key dired-mode-map "r" 'wdired-change-to-wdired-mode)
86;; (define-key dired-mode-map
87;; [menu-bar immediate wdired-change-to-wdired-mode]
88;; '("Edit File Names" . wdired-change-to-wdired-mode))))
89;;
90;;
91;; Type "M-x customize-group RET wdired" if you want make changes to
92;; the default behavior.
93
94;;; Usage:
95
96;; Then, you can start editing the names of the files by typing "r"
97;; (or whatever key you choose, or M-x wdired-change-to-wdired-mode).
98;; Use C-c C-c when finished or C-c C-k to abort. You can use also the
99;; menu options: in dired mode, "Edit File Names" under "Immediate".
100;; While editing the names, a new submenu "WDired" is available at top
101;; level. You can customize the behavior of this package from this
102;; menu.
103
104;;; Change Log:
105
106;; From 1.9 to 1.91
107;;
108;; - Fixed a bug (introduced in 1.9) so now files can be marked for
109;; deletion again, by deleting their whole filename.
110
111;; From 1.8 to 1.9
112;;
113;; - Another alternative way of editing permissions allowed, see
114;; `wdired-allow-to-change-permissions' for details.
115;;
116;; - Now wdired doesn't rely on regexp so much. As a consequence of
117;; this, you can add newlines to filenames and symlinks targets
118;; (although this is not very usual, IMHO). Please note that dired
119;; (at least in Emacs 21.1 and previous) does not work very well
120;; with filenames with newlines in them, so RET is deactivated in
121;; wdired mode. But you can activate it if you want.
122;;
123;; - Now `upcase-word' `capitalize-word' and `downcase-word' are not
124;; advised to work better with wdired mode, but the keys bound to
125;; them use wdired versions of those commands.
126;;
127;; - Now "undo" actions are not inherited from wdired mode when
128;; changing to dired mode.
129;;
130;; - Code and documentation cleanups.
131;;
132;; - Fixed a bug that was making wdired to fail on users with
133;; `dired-backup-overwrite' set to t.
134;;
135;; - C-c C-[ now abort changes.
136
137;; From 1.7 to 1.8
138;;
139;; - Now permission (access-control) bits of the files can be changed.
140;; Please see the commentary section and the custom variable
141;; `wdired-allow-to-change-permissions' for details.
142;;
143;; - Added another possible value for the variable
144;; `wdired-always-move-to-filename-beginning', useful to change
145;; permission bits of several files without the cursor jumping to
146;; filenames when changing lines.
147
148;; From 0.1 to 1.7
149
150;; - I've moved the list of changes to another file, because it was
151;; huge. Ask me for it or search older versions in google.
152
153;;; TODO:
154
155;; - Make it to work in XEmacs. Any volunteer?
156
157;;; Code:
158
159(eval-when-compile
160 (require 'advice)
161 (defvar dired-backup-overwrite) ; Only in emacs 20.x this is a custom var
162 (set (make-local-variable 'byte-compile-dynamic) t))
163
164(eval-and-compile
165 (require 'dired)
166 (autoload 'dired-do-create-files-regexp "dired-aux")
167 (autoload 'dired-call-process "dired-aux"))
168
169(defgroup wdired nil
170 "Mode to rename files by editing their names in dired buffers."
171 :group 'dired)
172
173(defcustom wdired-use-interactive-rename nil
174 "*If t, confirmation is required before actually rename the files.
175Confirmation is required also for overwriting files. If nil, no
176confirmation is required for change the file names, and the variable
177`wdired-is-ok-overwrite' is used to see if it is ok to overwrite files
178without asking."
179 :type 'boolean
180 :group 'wdired)
181
182(defcustom wdired-is-ok-overwrite nil
183 "*If non-nil the renames can overwrite files without asking.
184This variable is used only if `wdired-use-interactive-rename' is nil."
185 :type 'boolean
186 :group 'wdired)
187
188(defcustom wdired-always-move-to-filename-beginning nil
189 "*If t the \"up\" and \"down\" movement is done as in dired mode.
190That is, always move the point to the beginning of the filename at line.
191
192If `sometimes, only move to the beginning of filename if the point is
193before it, and `track-eol' is honored. This behavior is very handy
194when editing several filenames.
195
196If nil, \"up\" and \"down\" movement is done as in any other buffer."
197 :type '(choice (const :tag "As in any other mode" nil)
198 (const :tag "Smart cursor placement" sometimes)
199 (other :tag "As in dired mode" t))
200 :group 'wdired)
201
202(defcustom wdired-advise-functions t
203 "*If t some editing commands are advised when wdired is loaded.
204The advice only has effect in wdired mode. These commands are
205`query-replace' `query-replace-regexp' `replace-string', and the
206advice makes them to ignore read-only regions, so no attempts to
207modify these regions are done by them, and so they don't end
208prematurely.
209
210Setting this to nil does not unadvise the functions, if they are
211already advised, but new Emacs will not advise them."
212 :type 'boolean
213 :group 'wdired)
214
215(defcustom wdired-allow-to-redirect-links t
216 "*If non-nil, the target of the symbolic links can be changed also.
217In systems without symbolic links support, this variable has no effect
218at all."
219 :type 'boolean
220 :group 'wdired)
221
222(defcustom wdired-allow-to-change-permissions nil
223 "*If non-nil, the permissions bits of the files can be changed also.
224
225If t, to change a single bit, put the cursor over it and press the
226space bar, or left click over it. You can also hit the letter you want
227to set: if this value is allowed, the character in the buffer will be
228changed. Anyway, the point is advanced one position, so, for example,
229you can keep the \"x\" key pressed to give execution permissions to
230everybody to that file.
231
232If `advanced, the bits are freely editable. You can use
233`string-rectangle', `query-replace', etc. You can put any value (even
234newlines), but if you want your changes to be useful, you better put a
235intelligible value.
236
237Anyway, the real change of the permissions is done with the external
238program `dired-chmod-program', which must exist."
239 :type '(choice (const :tag "Not allowed" nil)
240 (const :tag "Toggle/set bits" t)
241 (other :tag "Bits freely editable" advanced))
242 :group 'wdired)
243
244(defvar wdired-mode-map
245 (let ((map (make-sparse-keymap)))
246 (define-key map "\C-x\C-s" 'wdired-finish-edit)
247 (define-key map "\C-c\C-c" 'wdired-finish-edit)
248 (define-key map "\C-c\C-k" 'wdired-abort-changes)
249 (define-key map "\C-c\C-[" 'wdired-abort-changes)
250 (define-key map "\C-m" 'wdired-newline)
251 (define-key map "\C-j" 'wdired-newline)
252 (define-key map "\C-o" 'wdired-newline)
253 (define-key map [up] 'wdired-previous-line)
254 (define-key map "\C-p" 'wdired-previous-line)
255 (define-key map [down] 'wdired-next-line)
256 (define-key map "\C-n" 'wdired-next-line)
257
258 (define-key map [menu-bar wdired]
259 (cons "WDired" (make-sparse-keymap "WDired")))
260 (define-key map [menu-bar wdired wdired-customize]
261 '("Options" . wdired-customize))
262 (define-key map [menu-bar wdired dashes]
263 '("--"))
264 (define-key map [menu-bar wdired wdired-abort-changes]
265 '("Abort Changes" . wdired-abort-changes))
266 (define-key map [menu-bar wdired wdired-finish-edit]
267 '("Commit Changes" . wdired-finish-edit))
268 ;; FIXME: Use the new remap trick.
269 (substitute-key-definition 'upcase-word 'wdired-upcase-word
270 map global-map)
271 (substitute-key-definition 'capitalize-word 'wdired-capitalize-word
272 map global-map)
273 (substitute-key-definition 'downcase-word 'wdired-downcase-word
274 map global-map)
275 map))
276
277(defvar wdired-mode-hook nil
278 "Hook run when changing to wdired mode.")
279
280;; Local variables (put here to avoid compilation gripes)
281(defvar wdired-col-perm) ;; Column where the permission bits start
282(defvar wdired-old-content)
283
284
285(defun wdired-mode ()
286 "\\<wdired-mode-map>File Names Editing mode.
287
288Press \\[wdired-finish-edit] to make the changes to take effect and
289exit. To abort the edit, use \\[wdired-abort-changes].
290
291In this mode you can edit the names of the files, the target of the
292links and the permission bits of the files. You can `customize-group'
293wdired.
294
295Editing things out of the filenames, or adding or deleting lines is
296not allowed, because the rest of the buffer is read-only."
297 (interactive)
298 (error "This mode can be enabled only by `wdired-change-to-wdired-mode'"))
299(put 'wdired-mode 'mode-class 'special)
300
301
302;;;###autoload
303(defun wdired-change-to-wdired-mode ()
304 "Put a dired buffer in a mode in which filenames are editable.
305In this mode the names of the files can be changed, and after
306typing C-c C-c the files and directories in disk are renamed.
307
308See `wdired-mode'."
309 (interactive)
310 (set (make-local-variable 'wdired-old-content)
311 (buffer-substring (point-min) (point-max)))
312 (use-local-map wdired-mode-map)
313 (force-mode-line-update)
314 (setq buffer-read-only nil)
315 (dired-unadvertise default-directory)
316 (add-hook 'kill-buffer-hook 'wdired-check-kill-buffer nil t)
317 (setq major-mode 'wdired-mode)
318 (setq mode-name "Edit filenames")
319 (setq revert-buffer-function 'wdired-revert)
320 ;; I temp disable undo for performance: since I'm going to clear the
321 ;; undo list, it can save more than a 9% of time with big
322 ;; directories because setting properties modify the undo-list.
323 (buffer-disable-undo)
324 (wdired-preprocess-files)
325 (if wdired-allow-to-change-permissions
326 (wdired-preprocess-perms))
327 (if (and wdired-allow-to-redirect-links (fboundp 'make-symbolic-link))
328 (wdired-preprocess-symlinks))
329 (buffer-enable-undo) ; Performance hack. See above.
330 (set-buffer-modified-p nil)
331 (setq buffer-undo-list nil)
332 (run-hooks wdired-mode-hook)
333 (message "Press C-c C-c when finished"))
334
335
336;; Protect the buffer so only the filenames can be changed, and put
337;; properties so filenames (old and new) can be easily found.
338(defun wdired-preprocess-files ()
339 (put-text-property 1 2 'front-sticky t)
340 (save-excursion
341 (goto-char (point-min))
342 (let ((b-protection (point))
343 filename)
344 (while (not (eobp))
345 (setq filename (dired-get-filename nil t))
346 (when (and filename
347 (not (member (file-name-nondirectory filename) '("." ".."))))
348 (dired-move-to-filename)
349 (put-text-property (- (point) 2) (1- (point)) 'old-name filename)
350 (put-text-property b-protection (1- (point)) 'read-only t)
351 (setq b-protection (dired-move-to-end-of-filename t)))
352 (put-text-property (point) (1+ (point)) 'end-name t)
353 (forward-line))
354 (put-text-property b-protection (point-max) 'read-only t))))
355
356;; This code is a copy of some dired-get-filename lines.
357(defsubst wdired-normalize-filename (file)
358 (setq file
359 ;; FIXME: shouldn't we check for a `b' argument or somesuch before
360 ;; doing such unquoting? --Stef
361 (read (concat
362 "\"" (replace-regexp-in-string
363 "\\([^\\]\\|\\`\\)\"" "\\1\\\\\"" file)
364 "\"")))
365 (and file buffer-file-coding-system
366 (not file-name-coding-system)
367 (not default-file-name-coding-system)
368 (setq file (encode-coding-string file buffer-file-coding-system)))
369 file)
370
371(defun wdired-get-filename (&optional no-dir old)
372 "Return the filename at line.
373Similar to `dired-get-filename' but it doesn't rely on regexps. It
374relies on wdired buffer's properties. Optional arg NO-DIR with value
375non-nil means don't include directory. Optional arg OLD with value
376non-nil means return old filename."
377 ;; FIXME: Use dired-get-filename's new properties.
378 (let (beg end file)
379 (save-excursion
380 (setq end (progn (end-of-line) (point)))
381 (beginning-of-line)
382 (setq beg (next-single-property-change (point) 'old-name nil end))
383 (unless (eq beg end)
384 (if old
385 (setq file (get-text-property beg 'old-name))
386 (setq end (next-single-property-change (1+ beg) 'end-name))
387 (setq file (buffer-substring-no-properties (+ 2 beg) end)))
388 (and file (setq file (wdired-normalize-filename file))))
389 (if (or no-dir old)
390 file
391 (and file (> (length file) 0)
392 (concat (dired-current-directory) file))))))
393
394
395(defun wdired-change-to-dired-mode ()
396 "Change the mode back to dired."
397 (let ((inhibit-read-only t))
398 (remove-text-properties (point-min) (point-max)
399 '(read-only nil local-map nil)))
400 (put-text-property 1 2 'front-sticky nil)
401 (use-local-map dired-mode-map)
402 (force-mode-line-update)
403 (setq buffer-read-only t)
404 (setq major-mode 'dired-mode)
405 (setq mode-name "Dired")
406 (dired-advertise)
407 (remove-hook 'kill-buffer-hook 'wdired-check-kill-buffer t)
408 (setq revert-buffer-function 'dired-revert))
409
410
411(defun wdired-abort-changes ()
412 "Abort changes and return to dired mode."
413 (interactive)
414 (let ((inhibit-read-only t))
415 (erase-buffer)
416 (insert wdired-old-content))
417 (wdired-change-to-dired-mode)
418 (set-buffer-modified-p nil)
419 (setq buffer-undo-list nil))
420
421(defun wdired-finish-edit ()
422 "Actually rename files based on your editing in the Dired buffer."
423 (interactive)
424 (wdired-change-to-dired-mode)
425 (let ((overwrite (or wdired-is-ok-overwrite 1))
426 (changes nil)
427 (files-deleted nil)
428 (errors 0)
429 file-ori file-new tmp-value)
430 (save-excursion
431 (if (and wdired-allow-to-redirect-links
432 (fboundp 'make-symbolic-link))
433 (progn
434 (setq tmp-value (wdired-do-symlink-changes))
435 (setq errors (cdr tmp-value))
436 (setq changes (car tmp-value))))
437 (if (and wdired-allow-to-change-permissions
438 (boundp 'wdired-col-perm)) ; could have been changed
439 (progn
440 (setq tmp-value (wdired-do-perm-changes))
441 (setq errors (+ errors (cdr tmp-value)))
442 (setq changes (or changes (car tmp-value)))))
443 (goto-char (point-max))
444 (while (not (bobp))
445 (setq file-ori (wdired-get-filename nil t))
446 (if file-ori
447 (setq file-new (wdired-get-filename)))
448 (if (and file-ori (not (equal file-new file-ori)))
449 (progn
450 (setq changes t)
451 (if (not file-new) ;empty filename!
452 (setq files-deleted (cons file-ori files-deleted))
453 (progn
454 (setq file-new (substitute-in-file-name file-new))
455 (if wdired-use-interactive-rename
456 (wdired-search-and-rename file-ori file-new)
457 (condition-case err
458 (let ((dired-backup-overwrite nil))
459 (dired-rename-file file-ori file-new
460 overwrite))
461 (error
462 (setq errors (1+ errors))
463 (dired-log (concat "Rename `" file-ori "' to `"
464 file-new "' failed:\n%s\n")
465 err))))))))
466 (forward-line -1)))
467 (if changes
468 (revert-buffer) ;The "revert" is necessary to re-sort the buffer
469 (let ((buffer-read-only nil))
470 (remove-text-properties (point-min) (point-max)
471 '(old-name nil end-name nil old-link nil
472 end-link nil end-perm nil
473 old-perm nil perm-changed nil))
474 (message "(No changes to be performed)")))
475 (if files-deleted
476 (wdired-flag-for-deletion files-deleted))
477 (if (> errors 0)
478 (dired-log-summary (format "%d rename actions failed" errors) nil)))
479 (set-buffer-modified-p nil)
480 (setq buffer-undo-list nil))
481
482;; Renames a file, searching it in a modified dired buffer, in order
483;; to be able to use `dired-do-create-files-regexp' and get its
484;; "benefits"
485(defun wdired-search-and-rename (filename-ori filename-new)
486 (save-excursion
487 (goto-char (point-max))
488 (forward-line -1)
489 (let ((exit-while nil)
490 curr-filename)
491 (while (not exit-while)
492 (setq curr-filename (wdired-get-filename))
493 (if (and curr-filename
494 (equal (substitute-in-file-name curr-filename) filename-new))
495 (progn
496 (setq exit-while t)
497 (let ((inhibit-read-only t))
498 (dired-move-to-filename)
499 (search-forward (wdired-get-filename t) nil t)
500 (replace-match (file-name-nondirectory filename-ori) t t))
501 (dired-do-create-files-regexp
502 (function dired-rename-file)
503 "Move" 1 ".*" filename-new nil t))
504 (progn
505 (forward-line -1)
506 (beginning-of-line)
507 (setq exit-while (= 1 (point)))))))))
508
509;; marks a list of files for deletion
510(defun wdired-flag-for-deletion (filenames-ori)
511 (save-excursion
512 (goto-char (point-min))
513 (while (not (eobp))
514 (if (member (dired-get-filename nil t) filenames-ori)
515 (dired-flag-file-deletion 1)
516 (forward-line)))))
517
518(defun wdired-customize ()
519 "Customize wdired options."
520 (interactive)
521 (customize-apropos "wdired" 'groups))
522
523(defun wdired-revert (&optional arg noconfirm)
524 "Discard changes in the buffer and update the changes in the disk."
525 (wdired-change-to-dired-mode)
526 (revert-buffer)
527 (wdired-change-to-wdired-mode))
528
529(defun wdired-check-kill-buffer ()
530 ;; FIXME: Can't we use the normal mechanism for that? --Stef
531 (if (and
532 (buffer-modified-p)
533 (not (y-or-n-p "Buffer changed. Discard changes and kill buffer? ")))
534 (error nil)))
535
536(defun wdired-next-line (arg)
537 "Move down lines then position at filename or the current column.
538See `wdired-always-move-to-filename-beginning'. Optional prefix ARG
539says how many lines to move; default is one line."
540 (interactive "p")
541 (next-line arg)
542 (if (or (eq wdired-always-move-to-filename-beginning t)
543 (and wdired-always-move-to-filename-beginning
544 (< (current-column)
545 (save-excursion (dired-move-to-filename)
546 (current-column)))))
547 (dired-move-to-filename)))
548
549(defun wdired-previous-line (arg)
550 "Move up lines then position at filename or the current column.
551See `wdired-always-move-to-filename-beginning'. Optional prefix ARG
552says how many lines to move; default is one line."
553 (interactive "p")
554 (previous-line arg)
555 (if (or (eq wdired-always-move-to-filename-beginning t)
556 (and wdired-always-move-to-filename-beginning
557 (< (current-column)
558 (save-excursion (dired-move-to-filename)
559 (current-column)))))
560 (dired-move-to-filename)))
561
562;; dired doesn't works well with newlines, so ...
563(defun wdired-newline ()
564 "Do nothing."
565 (interactive))
566
567;; Put the needed properties to allow the user to change links' targets
568(defun wdired-preprocess-symlinks ()
569 (let ((inhibit-read-only t))
570 (save-excursion
571 (goto-char (point-min))
572 (while (not (eobp))
573 (if (looking-at dired-re-sym)
574 (progn
575 (re-search-forward " -> \\(.*\\)$")
576 (put-text-property (- (match-beginning 1) 2)
577 (1- (match-beginning 1)) 'old-link
578 (match-string-no-properties 1))
579 (put-text-property (match-end 1) (1+ (match-end 1)) 'end-link t)
580 (put-text-property (1- (match-beginning 1))
581 (match-end 1) 'read-only nil)))
582 (forward-line)
583 (beginning-of-line)))))
584
585
586(defun wdired-get-previous-link (&optional old move)
587 "Return the next symlink target.
588If OLD, return the old target. If MOVE, move point before it."
589 (let (beg end target)
590 (setq beg (previous-single-property-change (point) 'old-link nil))
591 (if beg
592 (progn
593 (if old
594 (setq target (get-text-property (1- beg) 'old-link))
595 (setq end (next-single-property-change beg 'end-link))
596 (setq target (buffer-substring-no-properties (1+ beg) end)))
597 (if move (goto-char (1- beg)))))
598 (and target (wdired-normalize-filename target))))
599
600
601
602;; Perform the changes in the target of the changed links.
603(defun wdired-do-symlink-changes()
604 (let ((changes nil)
605 (errors 0)
606 link-to-ori link-to-new link-from)
607 (goto-char (point-max))
608 (while (setq link-to-new (wdired-get-previous-link))
609 (setq link-to-ori (wdired-get-previous-link t t))
610 (setq link-from (wdired-get-filename nil t))
611 (if (not (equal link-to-new link-to-ori))
612 (progn
613 (setq changes t)
614 (if (equal link-to-new "") ;empty filename!
615 (setq link-to-new "/dev/null"))
616 (condition-case err
617 (progn
618 (delete-file link-from)
619 (make-symbolic-link
620 (substitute-in-file-name link-to-new) link-from))
621 (error
622 (setq errors (1+ errors))
623 (dired-log (concat "Link `" link-from "' to `"
624 link-to-new "' failed:\n%s\n")
625 err))))))
626 (cons changes errors)))
627
628;; Perform a "case command" skipping read-only words.
629(defun wdired-xcase-word (command arg)
630 (if (< arg 0)
631 (funcall command arg)
632 (progn
633 (while (> arg 0)
634 (condition-case err
635 (progn
636 (funcall command 1)
637 (setq arg (1- arg)))
638 (error
639 (if (not (forward-word 1))
640 (setq arg 0))))))))
641
642(defun wdired-downcase-word (arg)
643 "Wdired version of `downcase-word'.
644Like original function but it skips read-only words."
645 (interactive "p")
646 (wdired-xcase-word 'downcase-word arg))
647
648(defun wdired-upcase-word (arg)
649 "Wdired version of `upcase-word'.
650Like original function but it skips read-only words."
651 (interactive "p")
652 (wdired-xcase-word 'upcase-word arg))
653
654(defun wdired-capitalize-word (arg)
655 "Wdired version of `capitalize-word'.
656Like original function but it skips read-only words."
657 (interactive "p")
658 (wdired-xcase-word 'capitalize-word arg))
659
660;; The following code is related to advice some interactive functions
661;; to make some editing commands in wdired mode not to fail trying to
662;; change read-only text. Notice that some advises advice and unadvise
663;; them-self to another functions: search-forward and
664;; re-search-forward. This is to keep these functions advised only
665;; when is necessary. Since they are built-in commands used heavily in
666;; lots of places, to have it permanently advised would cause some
667;; performance loss.
668
669
670(defun wdired-add-skip-in-replace (command)
671 "Advice COMMAND to skip matches while they have read-only properties.
672This is useful to avoid \"read-only\" errors in search and replace
673commands. This advice only has effect in wdired mode."
674 (eval
675 `(defadvice ,command (around wdired-discard-read-only activate)
676 ,(format "Make %s to work better with wdired,\n%s." command
677 "skipping read-only matches when invoked without argument")
678 ad-do-it
679 (if (eq major-mode 'wdired-mode)
680 (while (and ad-return-value
681 (text-property-any
682 (max 1 (1- (match-beginning 0))) (match-end 0)
683 'read-only t))
684 ad-do-it))
685 ad-return-value)))
686
687
688(defun wdired-add-replace-advice (command)
689 "Advice COMMAND to skip matches while they have read-only properties.
690This is useful to avoid \"read-only\" errors in search and replace
691commands. This advice only has effect in wdired mode."
692 (eval
693 `(defadvice ,command (around wdired-grok-read-only activate)
694 ,(format "Make %s to work better with wdired,\n%s." command
695 "skipping read-only matches when invoked without argument")
696 (if (eq major-mode 'wdired-mode)
697 (progn
698 (wdired-add-skip-in-replace 'search-forward)
699 (wdired-add-skip-in-replace 're-search-forward)
700 (unwind-protect
701 ad-do-it
702 (progn
703 (ad-remove-advice 'search-forward
704 'around 'wdired-discard-read-only)
705 (ad-remove-advice 're-search-forward
706 'around 'wdired-discard-read-only)
707 (ad-update 'search-forward)
708 (ad-update 're-search-forward))))
709 ad-do-it)
710 ad-return-value)))
711
712
713(if wdired-advise-functions
714 (progn
715 (mapcar 'wdired-add-replace-advice
716 '(query-replace query-replace-regexp replace-string))))
717
718
719;; The following code deals with changing the access bits (or
720;; permissions) of the files.
721
722(defvar wdired-perm-mode-map nil)
723(unless wdired-perm-mode-map
724 (setq wdired-perm-mode-map (copy-keymap wdired-mode-map))
725 (define-key wdired-perm-mode-map " " 'wdired-toggle-bit)
726 (define-key wdired-perm-mode-map "r" 'wdired-set-bit)
727 (define-key wdired-perm-mode-map "w" 'wdired-set-bit)
728 (define-key wdired-perm-mode-map "x" 'wdired-set-bit)
729 (define-key wdired-perm-mode-map "-" 'wdired-set-bit)
730 (define-key wdired-perm-mode-map "S" 'wdired-set-bit)
731 (define-key wdired-perm-mode-map "s" 'wdired-set-bit)
732 (define-key wdired-perm-mode-map "T" 'wdired-set-bit)
733 (define-key wdired-perm-mode-map "t" 'wdired-set-bit)
734 (define-key wdired-perm-mode-map "s" 'wdired-set-bit)
735 (define-key wdired-perm-mode-map "l" 'wdired-set-bit)
736 (define-key wdired-perm-mode-map [down-mouse-1] 'wdired-mouse-toggle-bit))
737
738;; Put a local-map to the permission bits of the files, and store the
739;; original name and permissions as a property
740(defun wdired-preprocess-perms()
741 (let ((inhibit-read-only t)
742 filename)
743 (set (make-local-variable 'wdired-col-perm) nil)
744 (save-excursion
745 (goto-char (point-min))
746 (while (not (eobp))
747 (if (and (not (looking-at dired-re-sym))
748 (setq filename (wdired-get-filename)))
749 (progn
750 (re-search-forward dired-re-perms)
751 (or wdired-col-perm
752 (setq wdired-col-perm (- (current-column) 9)))
753 (if (eq wdired-allow-to-change-permissions 'advanced)
754 (put-text-property (match-beginning 0) (match-end 0)
755 'read-only nil)
756 (put-text-property (1+ (match-beginning 0)) (match-end 0)
757 'local-map wdired-perm-mode-map))
758 (put-text-property (match-end 0) (1+ (match-end 0)) 'end-perm t)
759 (put-text-property (match-beginning 0) (1+ (match-beginning 0))
760 'old-perm (match-string-no-properties 0))))
761 (forward-line)
762 (beginning-of-line)))))
763
764(defun wdired-perm-allowed-in-pos (char pos)
765 (cond
766 ((= char ?-) t)
767 ((= char ?r) (= (% pos 3) 0))
768 ((= char ?w) (= (% pos 3) 1))
769 ((= char ?x) (= (% pos 3) 2))
770 ((memq char '(?s ?S)) (memq pos '(2 5)))
771 ((memq char '(?t ?T)) (= pos 8))
772 ((= char ?l) (= pos 5))))
773
774(defun wdired-set-bit ()
775 "Set a permission bit character."
776 (interactive)
777 (if (wdired-perm-allowed-in-pos last-command-char
778 (- (current-column) wdired-col-perm))
779 (let ((new-bit (char-to-string last-command-char))
780 (inhibit-read-only t)
781 (pos-prop (- (point) (- (current-column) wdired-col-perm))))
782 (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit)
783 (put-text-property 0 1 'read-only t new-bit)
784 (insert new-bit)
785 (delete-char 1)
786 (put-text-property pos-prop (1- pos-prop) 'perm-changed t))
787 (forward-char 1)))
788
789(defun wdired-toggle-bit()
790 "Toggle the permission bit at point."
791 (interactive)
792 (let ((inhibit-read-only t)
793 (new-bit "-")
794 (pos-prop (- (point) (- (current-column) wdired-col-perm))))
795 (if (eq (char-after (point)) ?-)
796 (setq new-bit
797 (if (= (% (- (current-column) wdired-col-perm) 3) 0) "r"
798 (if (= (% (- (current-column) wdired-col-perm) 3) 1) "w"
799 "x"))))
800 (put-text-property 0 1 'local-map wdired-perm-mode-map new-bit)
801 (put-text-property 0 1 'read-only t new-bit)
802 (insert new-bit)
803 (delete-char 1)
804 (put-text-property pos-prop (1- pos-prop) 'perm-changed t)))
805
806(defun wdired-mouse-toggle-bit (event)
807 "Toggle the permission bit that was left clicked."
808 (interactive "e")
809 (mouse-set-point event)
810 (wdired-toggle-bit))
811
812;; Allowed chars for 4000 bit are Ss in position 3
813;; Allowed chars for 2000 bit are Ssl in position 6
814;; Allowed chars for 1000 bit are Tt in position 9
815(defun wdired-perms-to-number (perms)
816 (let ((nperm 0777))
817 (if (= (elt perms 1) ?-) (setq nperm (- nperm 400)))
818 (if (= (elt perms 2) ?-) (setq nperm (- nperm 200)))
819 (let ((p-bit (elt perms 3)))
820 (if (memq p-bit '(?- ?S)) (setq nperm (- nperm 100)))
821 (if (memq p-bit '(?s ?S)) (setq nperm (+ nperm 4000))))
822 (if (= (elt perms 4) ?-) (setq nperm (- nperm 40)))
823 (if (= (elt perms 5) ?-) (setq nperm (- nperm 20)))
824 (let ((p-bit (elt perms 6)))
825 (if (memq p-bit '(?- ?S ?l)) (setq nperm (- nperm 10)))
826 (if (memq p-bit '(?s ?S ?l)) (setq nperm (+ nperm 2000))))
827 (if (= (elt perms 7) ?-) (setq nperm (- nperm 4)))
828 (if (= (elt perms 8) ?-) (setq nperm (- nperm 2)))
829 (let ((p-bit (elt perms 9)))
830 (if (memq p-bit '(?- ?T)) (setq nperm (- nperm 1)))
831 (if (memq p-bit '(?t ?T)) (setq nperm (+ nperm 1000))))
832 nperm))
833
834;; Perform the changes in the permissions of the files that have
835;; changed.
836(defun wdired-do-perm-changes ()
837 (let ((changes nil)
838 (errors 0)
839 (prop-wanted (if (eq wdired-allow-to-change-permissions 'advanced)
840 'old-perm 'perm-changed))
841 filename perms-ori perms-new perm-tmp)
842 (goto-char (next-single-property-change (point-min) prop-wanted
843 nil (point-max)))
844 (while (not (eobp))
845 (setq perms-ori (get-text-property (point) 'old-perm))
846 (setq perms-new (buffer-substring-no-properties
847 (point) (next-single-property-change (point) 'end-perm)))
848 (if (not (equal perms-ori perms-new))
849 (progn
850 (setq changes t)
851 (setq filename (wdired-get-filename nil t))
852 (if (= (length perms-new) 10)
853 (progn
854 (setq perm-tmp
855 (int-to-string (wdired-perms-to-number perms-new)))
856 (if (not (equal 0 (dired-call-process dired-chmod-program
857 t perm-tmp filename)))
858 (progn
859 (setq errors (1+ errors))
860 (dired-log (concat dired-chmod-program " " perm-tmp
861 " `" filename "' failed\n\n")))))
862 (setq errors (1+ errors))
863 (dired-log (concat "Cannot parse permission `" perms-new
864 "' for file `" filename "'\n\n")))))
865 (goto-char (next-single-property-change (1+ (point)) prop-wanted
866 nil (point-max))))
867 (cons changes errors)))
868
869(provide 'wdired)
870
871;; arch-tag: bc00902e-526f-4305-bc7f-8862a559184f
872;;; wdired.el ends here
diff --git a/src/ChangeLog b/src/ChangeLog
index 6bc622c8bff..4db9b8cb4d9 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,64 @@
12004-04-27 Kim F. Storm <storm@cua.dk>
2
3 * xdisp.c (x_produce_glyphs): Fix last change; handle newline in
4 header line strings.
5
6 * dispextern.h (struct it): New member use_default_face.
7
8 * xdisp.c (Qline_height): New variable.
9 (syms_of_xdisp): Intern and staticpro it.
10 (append_space_for_newline): Partially undo 2004-04-25 change;
11 add default_face_p arg, and restore callers.
12 Clear it->use_default_face after use.
13 (x_produce_glyphs): Set default font for ascii char if
14 it->use_default_font is set. Change line-spacing property to set
15 just extra line spacing. Handle new line-height property.
16
172004-04-26 Andreas Schwab <schwab@suse.de>
18
19 * print.c (print_object): Print non-ascii characters in bool
20 vector representation as octal escapes.
21
22 * lisp.h (BOOL_VECTOR_BITS_PER_CHAR): Define.
23 * print.c (print_object): Use it instead of BITS_PER_CHAR for
24 bool vectors.
25 * lread.c (read1): Likewise.
26 * alloc.c (Fmake_bool_vector): Likewise.
27 * data.c (Faref, Faset): Likewise.
28 * fns.c (Fcopy_sequence, concat, internal_equal, Ffillarray)
29 (mapcar1): Likewise.
30
312004-04-26 Steven Tamm <tamm@Steven-Tamms-Computer.local>
32
33 * lread.c (init_lread): Fixing typo HAVE_CARBON test logic
34
352004-04-26 Miles Bader <miles@gnu.org>
36
37 * lisp.h (CYCLE_CHECK): Macro moved from xfaces.c.
38
392004-04-26 Juanma Barranquero <lektu@terra.es>
40
41 * buffer.c (Fpop_to_buffer): Fix docstring.
42
432004-04-26 Steven Tamm <steventamm@mac.com>
44
45 * lread.c (init_lread): Don't display missing lisp directory
46 warnings with Carbon Emacs because self-contained bundled Emacs
47 may be built without correct installation path.
48
492004-04-25 Kim F. Storm <storm@cua.dk>
50
51 * macterm.c (x_draw_hollow_cursor): Fix height of box for narrow lines.
52
53 * xterm.c (x_draw_hollow_cursor): Fix height of box for narrow lines.
54
55 * xdisp.c (append_space_for_newline): Rename from append_space.
56 Remove DEFAULT_FACE_P arg; always use current face. Callers changed.
57 (x_produce_glyphs): Handle line-spacing property on newline char.
58 If value is t, adjust ascent and descent to fit current row height.
59 If value is an integer or float, set extra_line_spacing to integer
60 value, or to float value x current line height.
61
12004-04-23 Kenichi Handa <handa@m17n.org> 622004-04-23 Kenichi Handa <handa@m17n.org>
2 63
3 * fontset.c (Finternal_char_font): If POSITION is nil, return 64 * fontset.c (Finternal_char_font): If POSITION is nil, return
@@ -37,7 +98,7 @@
37 98
38 * lisp.h (pos_visible_p): Fix prototype. 99 * lisp.h (pos_visible_p): Fix prototype.
39 100
40 * macterm.c (x_draw_relief_rect): Add top_p and bot_p args. 101 * macterm.c (x_draw_relief_rect): Add top_p and bot_p args.
41 (x_draw_glyph_string_box): Fix call to x_draw_relief_rect. 102 (x_draw_glyph_string_box): Fix call to x_draw_relief_rect.
42 (x_draw_image_foreground, x_draw_image_relief) 103 (x_draw_image_foreground, x_draw_image_relief)
43 (x_draw_image_foreground_1, x_draw_image_glyph_string): 104 (x_draw_image_foreground_1, x_draw_image_glyph_string):
@@ -8334,12 +8395,11 @@
8334 8395
83352002-07-19 Juanma Barranquero <lektu@terra.es> 83962002-07-19 Juanma Barranquero <lektu@terra.es>
8336 8397
8337 * fileio.c (Ffile_name_as_directory): Fix argument name in docstring.
8338 (file_name_as_directory): Use literal '/' instead of DIRECTORY_SEP.
8339
8340 * xdisp.c (syms_of_xdisp): Remove redundant deprecation info. 8398 * xdisp.c (syms_of_xdisp): Remove redundant deprecation info.
8341 8399
8342 * fileio.c (syms_of_fileio): Likewise. 8400 * fileio.c (syms_of_fileio): Likewise.
8401 (Ffile_name_as_directory): Fix argument name in docstring.
8402 (file_name_as_directory): Use literal '/' instead of DIRECTORY_SEP.
8343 8403
83442002-07-18 Richard M. Stallman <rms@gnu.org> 84042002-07-18 Richard M. Stallman <rms@gnu.org>
8345 8405
@@ -11989,9 +12049,9 @@
11989 12049
11990 * abbrev.c (Fexpand_abbrev): Use Frun_hooks instead of Vrun_hooks. 12050 * abbrev.c (Fexpand_abbrev): Use Frun_hooks instead of Vrun_hooks.
11991 12051
11992 * buffer.c (Fkill_buffer): Use Frun_hooks, not Vrun_hooks. 12052 * buffer.c (Fkill_buffer): Likewise.
11993 12053
11994 * print.c (temp_output_buffer_setup): Use Frun_hooks, not Vrun_hooks. 12054 * print.c (temp_output_buffer_setup): Likewise.
11995 12055
119962001-11-25 Stefan Monnier <monnier@cs.yale.edu> 120562001-11-25 Stefan Monnier <monnier@cs.yale.edu>
11997 12057
diff --git a/src/alloc.c b/src/alloc.c
index 723d664cbe0..29351952860 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1950,10 +1950,11 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
1950 1950
1951 CHECK_NATNUM (length); 1951 CHECK_NATNUM (length);
1952 1952
1953 bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR; 1953 bits_per_value = sizeof (EMACS_INT) * BOOL_VECTOR_BITS_PER_CHAR;
1954 1954
1955 length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value; 1955 length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
1956 length_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) / BITS_PER_CHAR); 1956 length_in_chars = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
1957 / BOOL_VECTOR_BITS_PER_CHAR);
1957 1958
1958 /* We must allocate one more elements than LENGTH_IN_ELTS for the 1959 /* We must allocate one more elements than LENGTH_IN_ELTS for the
1959 slot `size' of the struct Lisp_Bool_Vector. */ 1960 slot `size' of the struct Lisp_Bool_Vector. */
@@ -1970,9 +1971,9 @@ LENGTH must be a number. INIT matters only in whether it is t or nil. */)
1970 p->data[i] = real_init; 1971 p->data[i] = real_init;
1971 1972
1972 /* Clear the extraneous bits in the last byte. */ 1973 /* Clear the extraneous bits in the last byte. */
1973 if (XINT (length) != length_in_chars * BITS_PER_CHAR) 1974 if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
1974 XBOOL_VECTOR (val)->data[length_in_chars - 1] 1975 XBOOL_VECTOR (val)->data[length_in_chars - 1]
1975 &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1; 1976 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
1976 1977
1977 return val; 1978 return val;
1978} 1979}
diff --git a/src/buffer.c b/src/buffer.c
index 6e67f07cf38..db16b22e35a 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1683,7 +1683,7 @@ DEFUN ("pop-to-buffer", Fpop_to_buffer, Spop_to_buffer, 1, 3, 0,
1683 doc: /* Select buffer BUFFER in some window, preferably a different one. 1683 doc: /* Select buffer BUFFER in some window, preferably a different one.
1684If BUFFER is nil, then some other buffer is chosen. 1684If BUFFER is nil, then some other buffer is chosen.
1685If `pop-up-windows' is non-nil, windows can be split to do this. 1685If `pop-up-windows' is non-nil, windows can be split to do this.
1686If optional second arg OTHER-WINDOW is nil, insist on finding another 1686If optional second arg OTHER-WINDOW is non-nil, insist on finding another
1687window even if BUFFER is already visible in the selected window, 1687window even if BUFFER is already visible in the selected window,
1688and ignore `same-window-regexps' and `same-window-buffer-names'. 1688and ignore `same-window-regexps' and `same-window-buffer-names'.
1689This uses the function `display-buffer' as a subroutine; see the documentation 1689This uses the function `display-buffer' as a subroutine; see the documentation
diff --git a/src/data.c b/src/data.c
index c3cf05e0f10..a5f28375635 100644
--- a/src/data.c
+++ b/src/data.c
@@ -1946,8 +1946,8 @@ or a byte-code object. IDX starts at 0. */)
1946 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) 1946 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
1947 args_out_of_range (array, idx); 1947 args_out_of_range (array, idx);
1948 1948
1949 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR]; 1949 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR];
1950 return (val & (1 << (idxval % BITS_PER_CHAR)) ? Qt : Qnil); 1950 return (val & (1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR)) ? Qt : Qnil);
1951 } 1951 }
1952 else if (CHAR_TABLE_P (array)) 1952 else if (CHAR_TABLE_P (array))
1953 { 1953 {
@@ -2074,13 +2074,13 @@ bool-vector. IDX starts at 0. */)
2074 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size) 2074 if (idxval < 0 || idxval >= XBOOL_VECTOR (array)->size)
2075 args_out_of_range (array, idx); 2075 args_out_of_range (array, idx);
2076 2076
2077 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR]; 2077 val = (unsigned char) XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR];
2078 2078
2079 if (! NILP (newelt)) 2079 if (! NILP (newelt))
2080 val |= 1 << (idxval % BITS_PER_CHAR); 2080 val |= 1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR);
2081 else 2081 else
2082 val &= ~(1 << (idxval % BITS_PER_CHAR)); 2082 val &= ~(1 << (idxval % BOOL_VECTOR_BITS_PER_CHAR));
2083 XBOOL_VECTOR (array)->data[idxval / BITS_PER_CHAR] = val; 2083 XBOOL_VECTOR (array)->data[idxval / BOOL_VECTOR_BITS_PER_CHAR] = val;
2084 } 2084 }
2085 else if (CHAR_TABLE_P (array)) 2085 else if (CHAR_TABLE_P (array))
2086 { 2086 {
diff --git a/src/dispextern.h b/src/dispextern.h
index a3fc28e2491..8e79211b319 100644
--- a/src/dispextern.h
+++ b/src/dispextern.h
@@ -1920,9 +1920,12 @@ struct it
1920 unsigned face_before_selective_p : 1; 1920 unsigned face_before_selective_p : 1;
1921 1921
1922 /* If 1, adjust current glyph so it does not increase current row 1922 /* If 1, adjust current glyph so it does not increase current row
1923 descent/ascent. */ 1923 descent/ascent (line-height property). Reset after this glyph. */
1924 unsigned constrain_row_ascent_descent_p : 1; 1924 unsigned constrain_row_ascent_descent_p : 1;
1925 1925
1926 /* If 1, show current glyph in default face. Reset after this glyph. */
1927 unsigned use_default_face : 1;
1928
1926 /* The ID of the default face to use. One of DEFAULT_FACE_ID, 1929 /* The ID of the default face to use. One of DEFAULT_FACE_ID,
1927 MODE_LINE_FACE_ID, etc, depending on what we are displaying. */ 1930 MODE_LINE_FACE_ID, etc, depending on what we are displaying. */
1928 int base_face_id; 1931 int base_face_id;
diff --git a/src/fns.c b/src/fns.c
index bb215317864..1dbb9fb7c33 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1,5 +1,5 @@
1/* Random utility Lisp functions. 1/* Random utility Lisp functions.
2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 2003 2 Copyright (C) 1985, 86, 87, 93, 94, 95, 97, 98, 99, 2000, 2001, 02, 03, 2004
3 Free Software Foundation, Inc. 3 Free Software Foundation, Inc.
4 4
5This file is part of GNU Emacs. 5This file is part of GNU Emacs.
@@ -513,7 +513,8 @@ with the original. */)
513 { 513 {
514 Lisp_Object val; 514 Lisp_Object val;
515 int size_in_chars 515 int size_in_chars
516 = (XBOOL_VECTOR (arg)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; 516 = ((XBOOL_VECTOR (arg)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
517 / BOOL_VECTOR_BITS_PER_CHAR);
517 518
518 val = Fmake_bool_vector (Flength (arg), Qnil); 519 val = Fmake_bool_vector (Flength (arg), Qnil);
519 bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data, 520 bcopy (XBOOL_VECTOR (arg)->data, XBOOL_VECTOR (val)->data,
@@ -783,8 +784,8 @@ concat (nargs, args, target_type, last_special)
783 else if (BOOL_VECTOR_P (this)) 784 else if (BOOL_VECTOR_P (this))
784 { 785 {
785 int byte; 786 int byte;
786 byte = XBOOL_VECTOR (this)->data[thisindex / BITS_PER_CHAR]; 787 byte = XBOOL_VECTOR (this)->data[thisindex / BOOL_VECTOR_BITS_PER_CHAR];
787 if (byte & (1 << (thisindex % BITS_PER_CHAR))) 788 if (byte & (1 << (thisindex % BOOL_VECTOR_BITS_PER_CHAR)))
788 elt = Qt; 789 elt = Qt;
789 else 790 else
790 elt = Qnil; 791 elt = Qnil;
@@ -2245,7 +2246,8 @@ internal_equal (o1, o2, depth, props)
2245 if (BOOL_VECTOR_P (o1)) 2246 if (BOOL_VECTOR_P (o1))
2246 { 2247 {
2247 int size_in_chars 2248 int size_in_chars
2248 = (XBOOL_VECTOR (o1)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; 2249 = ((XBOOL_VECTOR (o1)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
2250 / BOOL_VECTOR_BITS_PER_CHAR);
2249 2251
2250 if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size) 2252 if (XBOOL_VECTOR (o1)->size != XBOOL_VECTOR (o2)->size)
2251 return 0; 2253 return 0;
@@ -2356,7 +2358,8 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
2356 { 2358 {
2357 register unsigned char *p = XBOOL_VECTOR (array)->data; 2359 register unsigned char *p = XBOOL_VECTOR (array)->data;
2358 int size_in_chars 2360 int size_in_chars
2359 = (XBOOL_VECTOR (array)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; 2361 = ((XBOOL_VECTOR (array)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
2362 / BOOL_VECTOR_BITS_PER_CHAR);
2360 2363
2361 charval = (! NILP (item) ? -1 : 0); 2364 charval = (! NILP (item) ? -1 : 0);
2362 for (index = 0; index < size_in_chars - 1; index++) 2365 for (index = 0; index < size_in_chars - 1; index++)
@@ -2364,8 +2367,8 @@ ARRAY is a vector, string, char-table, or bool-vector. */)
2364 if (index < size_in_chars) 2367 if (index < size_in_chars)
2365 { 2368 {
2366 /* Mask out bits beyond the vector size. */ 2369 /* Mask out bits beyond the vector size. */
2367 if (XBOOL_VECTOR (array)->size % BITS_PER_CHAR) 2370 if (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)
2368 charval &= (1 << (XBOOL_VECTOR (array)->size % BITS_PER_CHAR)) - 1; 2371 charval &= (1 << (XBOOL_VECTOR (array)->size % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2369 p[index] = charval; 2372 p[index] = charval;
2370 } 2373 }
2371 } 2374 }
@@ -2958,8 +2961,8 @@ mapcar1 (leni, vals, fn, seq)
2958 for (i = 0; i < leni; i++) 2961 for (i = 0; i < leni; i++)
2959 { 2962 {
2960 int byte; 2963 int byte;
2961 byte = XBOOL_VECTOR (seq)->data[i / BITS_PER_CHAR]; 2964 byte = XBOOL_VECTOR (seq)->data[i / BOOL_VECTOR_BITS_PER_CHAR];
2962 if (byte & (1 << (i % BITS_PER_CHAR))) 2965 if (byte & (1 << (i % BOOL_VECTOR_BITS_PER_CHAR)))
2963 dummy = Qt; 2966 dummy = Qt;
2964 else 2967 else
2965 dummy = Qnil; 2968 dummy = Qnil;
diff --git a/src/lisp.h b/src/lisp.h
index bc67f4dbe67..7e59c50c3b4 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -278,6 +278,10 @@ enum pvec_type
278 278
279/* For convenience, we also store the number of elements in these bits. */ 279/* For convenience, we also store the number of elements in these bits. */
280#define PSEUDOVECTOR_SIZE_MASK 0x1ff 280#define PSEUDOVECTOR_SIZE_MASK 0x1ff
281
282/* Number of bits to put in each character in the internal representation
283 of bool vectors. This should not vary across implementations. */
284#define BOOL_VECTOR_BITS_PER_CHAR 8
281 285
282/***** Select the tagging scheme. *****/ 286/***** Select the tagging scheme. *****/
283 287
@@ -3187,6 +3191,32 @@ extern Lisp_Object Vdirectory_sep_char;
3187 ? make_float (val) \ 3191 ? make_float (val) \
3188 : make_number ((EMACS_INT)(val))) 3192 : make_number ((EMACS_INT)(val)))
3189 3193
3194
3195/* Checks the `cycle check' variable CHECK to see if it indicates that
3196 EL is part of a cycle; CHECK must be either Qnil or a value returned
3197 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3198 elements after which a cycle might be suspected; after that many
3199 elements, this macro begins consing in order to keep more precise
3200 track of elements.
3201
3202 Returns nil if a cycle was detected, otherwise a new value for CHECK
3203 that includes EL.
3204
3205 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3206 the caller should make sure that's ok. */
3207
3208#define CYCLE_CHECK(check, el, suspicious) \
3209 (NILP (check) \
3210 ? make_number (0) \
3211 : (INTEGERP (check) \
3212 ? (XFASTINT (check) < (suspicious) \
3213 ? make_number (XFASTINT (check) + 1) \
3214 : Fcons (el, Qnil)) \
3215 : (!NILP (Fmemq ((el), (check))) \
3216 ? Qnil \
3217 : Fcons ((el), (check)))))
3218
3219
3190#endif /* EMACS_LISP_H */ 3220#endif /* EMACS_LISP_H */
3191 3221
3192/* arch-tag: 9b2ed020-70eb-47ac-94ee-e1c2a5107d5e 3222/* arch-tag: 9b2ed020-70eb-47ac-94ee-e1c2a5107d5e
diff --git a/src/lread.c b/src/lread.c
index ac353c798dc..46fe6cd3e51 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1994,8 +1994,9 @@ read1 (readcharfun, pch, first_in_list)
1994 if (c == '"') 1994 if (c == '"')
1995 { 1995 {
1996 Lisp_Object tmp, val; 1996 Lisp_Object tmp, val;
1997 int size_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) 1997 int size_in_chars
1998 / BITS_PER_CHAR); 1998 = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
1999 / BOOL_VECTOR_BITS_PER_CHAR);
1999 2000
2000 UNREAD (c); 2001 UNREAD (c);
2001 tmp = read1 (readcharfun, pch, first_in_list); 2002 tmp = read1 (readcharfun, pch, first_in_list);
@@ -2004,7 +2005,7 @@ read1 (readcharfun, pch, first_in_list)
2004 when the number of bits was a multiple of 8. 2005 when the number of bits was a multiple of 8.
2005 Accept such input in case it came from an old version. */ 2006 Accept such input in case it came from an old version. */
2006 && ! (XFASTINT (length) 2007 && ! (XFASTINT (length)
2007 == (SCHARS (tmp) - 1) * BITS_PER_CHAR)) 2008 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
2008 Fsignal (Qinvalid_read_syntax, 2009 Fsignal (Qinvalid_read_syntax,
2009 Fcons (make_string ("#&...", 5), Qnil)); 2010 Fcons (make_string ("#&...", 5), Qnil));
2010 2011
@@ -2012,9 +2013,9 @@ read1 (readcharfun, pch, first_in_list)
2012 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data, 2013 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
2013 size_in_chars); 2014 size_in_chars);
2014 /* Clear the extraneous bits in the last byte. */ 2015 /* Clear the extraneous bits in the last byte. */
2015 if (XINT (length) != size_in_chars * BITS_PER_CHAR) 2016 if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
2016 XBOOL_VECTOR (val)->data[size_in_chars - 1] 2017 XBOOL_VECTOR (val)->data[size_in_chars - 1]
2017 &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1; 2018 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2018 return val; 2019 return val;
2019 } 2020 }
2020 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), 2021 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5),
@@ -3677,11 +3678,15 @@ init_lread ()
3677 } 3678 }
3678#endif 3679#endif
3679 3680
3680#ifndef WINDOWSNT 3681#if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON))))
3681 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is 3682 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3682 almost never correct, thereby causing a warning to be printed out that 3683 almost never correct, thereby causing a warning to be printed out that
3683 confuses users. Since PATH_LOADSEARCH is always overridden by the 3684 confuses users. Since PATH_LOADSEARCH is always overridden by the
3684 EMACSLOADPATH environment variable below, disable the warning on NT. */ 3685 EMACSLOADPATH environment variable below, disable the warning on NT.
3686 Also, when using the "self-contained" option for Carbon Emacs for MacOSX,
3687 the "standard" paths may not exist and would be overridden by
3688 EMACSLOADPATH as on NT. Since this depends on how the executable
3689 was build and packaged, turn off the warnings in general */
3685 3690
3686 /* Warn if dirs in the *standard* path don't exist. */ 3691 /* Warn if dirs in the *standard* path don't exist. */
3687 if (!turn_off_warning) 3692 if (!turn_off_warning)
@@ -3703,7 +3708,7 @@ init_lread ()
3703 } 3708 }
3704 } 3709 }
3705 } 3710 }
3706#endif /* WINDOWSNT */ 3711#endif /* !(WINDOWSNT || HAVE_CARBON) */
3707 3712
3708 /* If the EMACSLOADPATH environment variable is set, use its value. 3713 /* If the EMACSLOADPATH environment variable is set, use its value.
3709 This doesn't apply if we're dumping. */ 3714 This doesn't apply if we're dumping. */
diff --git a/src/macterm.c b/src/macterm.c
index 88f5fce468c..e825cc2b022 100644
--- a/src/macterm.c
+++ b/src/macterm.c
@@ -4665,7 +4665,8 @@ x_draw_hollow_cursor (w, row)
4665 /* Compute the proper height and ascent of the rectangle, based 4665 /* Compute the proper height and ascent of the rectangle, based
4666 on the actual glyph. Using the full height of the row looks 4666 on the actual glyph. Using the full height of the row looks
4667 bad when there are tall images on that row. */ 4667 bad when there are tall images on that row. */
4668 h = max (FRAME_LINE_HEIGHT (f), cursor_glyph->ascent + cursor_glyph->descent); 4668 h = max (min (FRAME_LINE_HEIGHT (f), row->height),
4669 cursor_glyph->ascent + cursor_glyph->descent);
4669 if (h < row->height) 4670 if (h < row->height)
4670 y += row->ascent /* - w->phys_cursor_ascent */ + cursor_glyph->descent - h; 4671 y += row->ascent /* - w->phys_cursor_ascent */ + cursor_glyph->descent - h;
4671 h--; 4672 h--;
diff --git a/src/print.c b/src/print.c
index 89690fe5399..7548bc75661 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1,5 +1,5 @@
1/* Lisp object printing and output streams. 1/* Lisp object printing and output streams.
2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 2003 2 Copyright (C) 1985, 86, 88, 93, 94, 95, 97, 98, 1999, 2000, 01, 03, 2004
3 Free Software Foundation, Inc. 3 Free Software Foundation, Inc.
4 4
5This file is part of GNU Emacs. 5This file is part of GNU Emacs.
@@ -1783,7 +1783,8 @@ print_object (obj, printcharfun, escapeflag)
1783 register unsigned char c; 1783 register unsigned char c;
1784 struct gcpro gcpro1; 1784 struct gcpro gcpro1;
1785 int size_in_chars 1785 int size_in_chars
1786 = (XBOOL_VECTOR (obj)->size + BITS_PER_CHAR - 1) / BITS_PER_CHAR; 1786 = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1)
1787 / BOOL_VECTOR_BITS_PER_CHAR);
1787 1788
1788 GCPRO1 (obj); 1789 GCPRO1 (obj);
1789 1790
@@ -1814,6 +1815,14 @@ print_object (obj, printcharfun, escapeflag)
1814 PRINTCHAR ('\\'); 1815 PRINTCHAR ('\\');
1815 PRINTCHAR ('f'); 1816 PRINTCHAR ('f');
1816 } 1817 }
1818 else if (c > '\177')
1819 {
1820 /* Use octal escapes to avoid encoding issues. */
1821 PRINTCHAR ('\\');
1822 PRINTCHAR ('0' + ((c >> 6) & 3));
1823 PRINTCHAR ('0' + ((c >> 3) & 7));
1824 PRINTCHAR ('0' + (c & 7));
1825 }
1817 else 1826 else
1818 { 1827 {
1819 if (c == '\"' || c == '\\') 1828 if (c == '\"' || c == '\\')
diff --git a/src/xdisp.c b/src/xdisp.c
index fd621fe301b..d5e12e68546 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -304,6 +304,7 @@ Lisp_Object Qleft_margin, Qright_margin, Qspace_width, Qraise;
304Lisp_Object Qslice; 304Lisp_Object Qslice;
305Lisp_Object Qcenter; 305Lisp_Object Qcenter;
306Lisp_Object Qmargin, Qpointer; 306Lisp_Object Qmargin, Qpointer;
307Lisp_Object Qline_height;
307extern Lisp_Object Qheight; 308extern Lisp_Object Qheight;
308extern Lisp_Object QCwidth, QCheight, QCascent; 309extern Lisp_Object QCwidth, QCheight, QCascent;
309extern Lisp_Object Qscroll_bar; 310extern Lisp_Object Qscroll_bar;
@@ -846,7 +847,7 @@ static void insert_left_trunc_glyphs P_ ((struct it *));
846static struct glyph_row *get_overlay_arrow_glyph_row P_ ((struct window *, 847static struct glyph_row *get_overlay_arrow_glyph_row P_ ((struct window *,
847 Lisp_Object)); 848 Lisp_Object));
848static void extend_face_to_end_of_line P_ ((struct it *)); 849static void extend_face_to_end_of_line P_ ((struct it *));
849static int append_space P_ ((struct it *, int)); 850static int append_space_for_newline P_ ((struct it *, int));
850static int make_cursor_line_fully_visible P_ ((struct window *, int)); 851static int make_cursor_line_fully_visible P_ ((struct window *, int));
851static int try_scrolling P_ ((Lisp_Object, int, EMACS_INT, EMACS_INT, int, int)); 852static int try_scrolling P_ ((Lisp_Object, int, EMACS_INT, EMACS_INT, int, int));
852static int try_cursor_movement P_ ((Lisp_Object, struct text_pos, int *)); 853static int try_cursor_movement P_ ((Lisp_Object, struct text_pos, int *));
@@ -14144,8 +14145,7 @@ compute_line_metrics (it)
14144 14145
14145 14146
14146/* Append one space to the glyph row of iterator IT if doing a 14147/* Append one space to the glyph row of iterator IT if doing a
14147 window-based redisplay. DEFAULT_FACE_P non-zero means let the 14148 window-based redisplay. The space has the same face as
14148 space have the default face, otherwise let it have the same face as
14149 IT->face_id. Value is non-zero if a space was added. 14149 IT->face_id. Value is non-zero if a space was added.
14150 14150
14151 This function is called to make sure that there is always one glyph 14151 This function is called to make sure that there is always one glyph
@@ -14157,7 +14157,7 @@ compute_line_metrics (it)
14157 end of the line if the row ends in italic text. */ 14157 end of the line if the row ends in italic text. */
14158 14158
14159static int 14159static int
14160append_space (it, default_face_p) 14160append_space_for_newline (it, default_face_p)
14161 struct it *it; 14161 struct it *it;
14162 int default_face_p; 14162 int default_face_p;
14163{ 14163{
@@ -14171,7 +14171,7 @@ append_space (it, default_face_p)
14171 /* Save some values that must not be changed. 14171 /* Save some values that must not be changed.
14172 Must save IT->c and IT->len because otherwise 14172 Must save IT->c and IT->len because otherwise
14173 ITERATOR_AT_END_P wouldn't work anymore after 14173 ITERATOR_AT_END_P wouldn't work anymore after
14174 append_space has been called. */ 14174 append_space_for_newline has been called. */
14175 enum display_element_type saved_what = it->what; 14175 enum display_element_type saved_what = it->what;
14176 int saved_c = it->c, saved_len = it->len; 14176 int saved_c = it->c, saved_len = it->len;
14177 int saved_x = it->current_x; 14177 int saved_x = it->current_x;
@@ -14196,11 +14196,9 @@ append_space (it, default_face_p)
14196 face = FACE_FROM_ID (it->f, it->face_id); 14196 face = FACE_FROM_ID (it->f, it->face_id);
14197 it->face_id = FACE_FOR_CHAR (it->f, face, 0); 14197 it->face_id = FACE_FOR_CHAR (it->f, face, 0);
14198 14198
14199 if (it->max_ascent > 0 || it->max_descent > 0)
14200 it->constrain_row_ascent_descent_p = 1;
14201
14202 PRODUCE_GLYPHS (it); 14199 PRODUCE_GLYPHS (it);
14203 14200
14201 it->use_default_face = 0;
14204 it->constrain_row_ascent_descent_p = 0; 14202 it->constrain_row_ascent_descent_p = 0;
14205 it->current_x = saved_x; 14203 it->current_x = saved_x;
14206 it->object = saved_object; 14204 it->object = saved_object;
@@ -14483,7 +14481,7 @@ display_line (it)
14483 row->exact_window_width_line_p = 1; 14481 row->exact_window_width_line_p = 1;
14484 else 14482 else
14485#endif /* HAVE_WINDOW_SYSTEM */ 14483#endif /* HAVE_WINDOW_SYSTEM */
14486 if ((append_space (it, 1) && row->used[TEXT_AREA] == 1) 14484 if ((append_space_for_newline (it, 1) && row->used[TEXT_AREA] == 1)
14487 || row->used[TEXT_AREA] == 0) 14485 || row->used[TEXT_AREA] == 0)
14488 { 14486 {
14489 row->glyphs[TEXT_AREA]->charpos = -1; 14487 row->glyphs[TEXT_AREA]->charpos = -1;
@@ -14725,7 +14723,7 @@ display_line (it)
14725 /* Add a space at the end of the line that is used to 14723 /* Add a space at the end of the line that is used to
14726 display the cursor there. */ 14724 display the cursor there. */
14727 if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it)) 14725 if (!IT_OVERFLOW_NEWLINE_INTO_FRINGE (it))
14728 append_space (it, 0); 14726 append_space_for_newline (it, 0);
14729#endif /* HAVE_WINDOW_SYSTEM */ 14727#endif /* HAVE_WINDOW_SYSTEM */
14730 14728
14731 /* Extend the face to the end of the line. */ 14729 /* Extend the face to the end of the line. */
@@ -18514,6 +18512,8 @@ void
18514x_produce_glyphs (it) 18512x_produce_glyphs (it)
18515 struct it *it; 18513 struct it *it;
18516{ 18514{
18515 int extra_line_spacing = it->extra_line_spacing;
18516
18517 it->glyph_not_available_p = 0; 18517 it->glyph_not_available_p = 0;
18518 18518
18519 if (it->what == IT_CHARACTER) 18519 if (it->what == IT_CHARACTER)
@@ -18589,6 +18589,12 @@ x_produce_glyphs (it)
18589 18589
18590 it->nglyphs = 1; 18590 it->nglyphs = 1;
18591 18591
18592 if (it->use_default_face)
18593 {
18594 font = FRAME_FONT (it->f);
18595 boff = FRAME_BASELINE_OFFSET (it->f);
18596 }
18597
18592 pcm = FRAME_RIF (it->f)->per_char_metric 18598 pcm = FRAME_RIF (it->f)->per_char_metric
18593 (font, &char2b, FONT_TYPE_FOR_UNIBYTE (font, it->char_to_display)); 18599 (font, &char2b, FONT_TYPE_FOR_UNIBYTE (font, it->char_to_display));
18594 18600
@@ -18612,18 +18618,19 @@ x_produce_glyphs (it)
18612 if (it->constrain_row_ascent_descent_p) 18618 if (it->constrain_row_ascent_descent_p)
18613 { 18619 {
18614 if (it->descent > it->max_descent) 18620 if (it->descent > it->max_descent)
18615 { 18621 {
18616 it->ascent += it->descent - it->max_descent; 18622 it->ascent += it->descent - it->max_descent;
18617 it->descent = it->max_descent; 18623 it->descent = it->max_descent;
18618 } 18624 }
18619 if (it->ascent> it->max_ascent) 18625 if (it->ascent > it->max_ascent)
18620 { 18626 {
18621 it->descent = min (it->max_descent, it->descent + it->ascent - it->max_ascent); 18627 it->descent = min (it->max_descent, it->descent + it->ascent - it->max_ascent);
18622 it->ascent = it->max_ascent; 18628 it->ascent = it->max_ascent;
18623 } 18629 }
18624 it->phys_ascent = min (it->phys_ascent, it->ascent); 18630 it->phys_ascent = min (it->phys_ascent, it->ascent);
18625 it->phys_descent = min (it->phys_descent, it->descent); 18631 it->phys_descent = min (it->phys_descent, it->descent);
18626 } 18632 extra_line_spacing = 0;
18633 }
18627 18634
18628 /* If this is a space inside a region of text with 18635 /* If this is a space inside a region of text with
18629 `space-width' property, change its width. */ 18636 `space-width' property, change its width. */
@@ -18695,32 +18702,68 @@ x_produce_glyphs (it)
18695 But if previous part of the line set a height, don't 18702 But if previous part of the line set a height, don't
18696 increase that height */ 18703 increase that height */
18697 18704
18705 Lisp_Object lsp, lh;
18706
18698 it->pixel_width = 0; 18707 it->pixel_width = 0;
18699 it->nglyphs = 0; 18708 it->nglyphs = 0;
18700 18709
18710 lh = Fget_text_property (IT_CHARPOS (*it), Qline_height, it->object);
18711
18712 if (EQ (lh, Qt))
18713 {
18714 it->use_default_face = 1;
18715 font = FRAME_FONT (it->f);
18716 boff = FRAME_BASELINE_OFFSET (it->f);
18717 font_info = NULL;
18718 }
18719
18701 it->ascent = FONT_BASE (font) + boff; 18720 it->ascent = FONT_BASE (font) + boff;
18702 it->descent = FONT_DESCENT (font) - boff; 18721 it->descent = FONT_DESCENT (font) - boff;
18703 18722
18704 if (it->max_ascent > 0 || it->max_descent > 0) 18723 if (EQ (lh, make_number (0)))
18705 { 18724 {
18706 it->ascent = it->descent = 0; 18725 if (it->descent > it->max_descent)
18726 {
18727 it->ascent += it->descent - it->max_descent;
18728 it->descent = it->max_descent;
18729 }
18730 if (it->ascent > it->max_ascent)
18731 {
18732 it->descent = min (it->max_descent, it->descent + it->ascent - it->max_ascent);
18733 it->ascent = it->max_ascent;
18734 }
18735 it->phys_ascent = min (it->phys_ascent, it->ascent);
18736 it->phys_descent = min (it->phys_descent, it->descent);
18737 it->constrain_row_ascent_descent_p = 1;
18738 extra_line_spacing = 0;
18707 } 18739 }
18708 else 18740 else
18709 { 18741 {
18710 it->ascent = FONT_BASE (font) + boff; 18742 int explicit_height = -1;
18711 it->descent = FONT_DESCENT (font) - boff; 18743 it->phys_ascent = it->ascent;
18712 } 18744 it->phys_descent = it->descent;
18713 18745
18714 it->phys_ascent = it->ascent; 18746 if ((it->max_ascent > 0 || it->max_descent > 0)
18715 it->phys_descent = it->descent; 18747 && face->box != FACE_NO_BOX
18748 && face->box_line_width > 0)
18749 {
18750 it->ascent += face->box_line_width;
18751 it->descent += face->box_line_width;
18752 }
18753 if (INTEGERP (lh))
18754 explicit_height = XINT (lh);
18755 else if (FLOATP (lh))
18756 explicit_height = (it->phys_ascent + it->phys_descent) * XFLOAT_DATA (lh);
18716 18757
18717 if ((it->max_ascent > 0 || it->max_descent > 0) 18758 if (explicit_height > it->ascent + it->descent)
18718 && face->box != FACE_NO_BOX 18759 it->ascent = explicit_height - it->descent;
18719 && face->box_line_width > 0)
18720 {
18721 it->ascent += face->box_line_width;
18722 it->descent += face->box_line_width;
18723 } 18760 }
18761
18762 lsp = Fget_text_property (IT_CHARPOS (*it), Qline_spacing, it->object);
18763 if (INTEGERP (lsp))
18764 extra_line_spacing = XINT (lsp);
18765 else if (FLOATP (lsp))
18766 extra_line_spacing = (it->phys_ascent + it->phys_descent) * XFLOAT_DATA (lsp);
18724 } 18767 }
18725 else if (it->char_to_display == '\t') 18768 else if (it->char_to_display == '\t')
18726 { 18769 {
@@ -19097,7 +19140,7 @@ x_produce_glyphs (it)
19097 if (it->area == TEXT_AREA) 19140 if (it->area == TEXT_AREA)
19098 it->current_x += it->pixel_width; 19141 it->current_x += it->pixel_width;
19099 19142
19100 it->descent += it->extra_line_spacing; 19143 it->descent += extra_line_spacing;
19101 19144
19102 it->max_ascent = max (it->max_ascent, it->ascent); 19145 it->max_ascent = max (it->max_ascent, it->ascent);
19103 it->max_descent = max (it->max_descent, it->descent); 19146 it->max_descent = max (it->max_descent, it->descent);
@@ -21743,6 +21786,8 @@ syms_of_xdisp ()
21743 staticpro (&Qright_margin); 21786 staticpro (&Qright_margin);
21744 Qcenter = intern ("center"); 21787 Qcenter = intern ("center");
21745 staticpro (&Qcenter); 21788 staticpro (&Qcenter);
21789 Qline_height = intern ("line-height");
21790 staticpro (&Qline_height);
21746 QCalign_to = intern (":align-to"); 21791 QCalign_to = intern (":align-to");
21747 staticpro (&QCalign_to); 21792 staticpro (&QCalign_to);
21748 QCrelative_width = intern (":relative-width"); 21793 QCrelative_width = intern (":relative-width");
diff --git a/src/xfaces.c b/src/xfaces.c
index 2e6d43a54b7..9e49833c736 100644
--- a/src/xfaces.c
+++ b/src/xfaces.c
@@ -3482,32 +3482,6 @@ merge_face_vectors (f, from, to, cycle_check)
3482 to[LFACE_INHERIT_INDEX] = Qnil; 3482 to[LFACE_INHERIT_INDEX] = Qnil;
3483} 3483}
3484 3484
3485
3486/* Checks the `cycle check' variable CHECK to see if it indicates that
3487 EL is part of a cycle; CHECK must be either Qnil or a value returned
3488 by an earlier use of CYCLE_CHECK. SUSPICIOUS is the number of
3489 elements after which a cycle might be suspected; after that many
3490 elements, this macro begins consing in order to keep more precise
3491 track of elements.
3492
3493 Returns nil if a cycle was detected, otherwise a new value for CHECK
3494 that includes EL.
3495
3496 CHECK is evaluated multiple times, EL and SUSPICIOUS 0 or 1 times, so
3497 the caller should make sure that's ok. */
3498
3499#define CYCLE_CHECK(check, el, suspicious) \
3500 (NILP (check) \
3501 ? make_number (0) \
3502 : (INTEGERP (check) \
3503 ? (XFASTINT (check) < (suspicious) \
3504 ? make_number (XFASTINT (check) + 1) \
3505 : Fcons (el, Qnil)) \
3506 : (!NILP (Fmemq ((el), (check))) \
3507 ? Qnil \
3508 : Fcons ((el), (check)))))
3509
3510
3511/* Merge face attributes from the face on frame F whose name is 3485/* Merge face attributes from the face on frame F whose name is
3512 INHERITS, into the vector of face attributes TO; INHERITS may also be 3486 INHERITS, into the vector of face attributes TO; INHERITS may also be
3513 a list of face names, in which case they are applied in order. 3487 a list of face names, in which case they are applied in order.
diff --git a/src/xterm.c b/src/xterm.c
index 838d4f2ad4b..b8be6c13041 100644
--- a/src/xterm.c
+++ b/src/xterm.c
@@ -7261,7 +7261,8 @@ x_draw_hollow_cursor (w, row)
7261 /* Compute the proper height and ascent of the rectangle, based 7261 /* Compute the proper height and ascent of the rectangle, based
7262 on the actual glyph. Using the full height of the row looks 7262 on the actual glyph. Using the full height of the row looks
7263 bad when there are tall images on that row. */ 7263 bad when there are tall images on that row. */
7264 h = max (FRAME_LINE_HEIGHT (f), cursor_glyph->ascent + cursor_glyph->descent); 7264 h = max (min (FRAME_LINE_HEIGHT (f), row->height),
7265 cursor_glyph->ascent + cursor_glyph->descent);
7265 if (h < row->height) 7266 if (h < row->height)
7266 y += row->ascent /* - w->phys_cursor_ascent */ + cursor_glyph->descent - h; 7267 y += row->ascent /* - w->phys_cursor_ascent */ + cursor_glyph->descent - h;
7267 h--; 7268 h--;