aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorKaroly Lorentey2004-05-07 14:20:00 +0000
committerKaroly Lorentey2004-05-07 14:20:00 +0000
commit52f9ab73a16c71ffe7f8a1c25f9432bbe32f10cf (patch)
tree399c54ddfa7cac6c90a07a81308bf7f5e71b66bd /lisp
parentb160ff41a813213adfa745a9d009ab638a22d7b1 (diff)
parenta478f3e181bd9925ecb506abf4e49216d392124a (diff)
downloademacs-52f9ab73a16c71ffe7f8a1c25f9432bbe32f10cf.tar.gz
emacs-52f9ab73a16c71ffe7f8a1c25f9432bbe32f10cf.zip
Merged in changes from CVS trunk.
Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-268 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-269 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-270 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-271 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-272 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-273 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-274 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-275 Update from CVS: man/makefile.w32-in: Revert last change * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-276 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-277 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-278 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-279 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-280 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-281 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-282 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-283 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-284 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-285 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-286 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-157
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog280
-rw-r--r--lisp/comint.el96
-rw-r--r--lisp/descr-text.el50
-rw-r--r--lisp/diff-mode.el26
-rw-r--r--lisp/ehelp.el22
-rw-r--r--lisp/emacs-lisp/byte-run.el18
-rw-r--r--lisp/emacs-lisp/re-builder.el2
-rw-r--r--lisp/emulation/cua-base.el3
-rw-r--r--lisp/gnus/ChangeLog4
-rw-r--r--lisp/gnus/nnimap.el14
-rw-r--r--lisp/help-fns.el113
-rw-r--r--lisp/ibuffer.el3
-rw-r--r--lisp/ido.el22
-rw-r--r--lisp/ielm.el23
-rw-r--r--lisp/iswitchb.el8
-rw-r--r--lisp/makefile.nt284
-rw-r--r--lisp/progmodes/compile.el51
-rw-r--r--lisp/progmodes/gdb-ui.el91
-rw-r--r--lisp/progmodes/python.el454
-rw-r--r--lisp/progmodes/sql.el96
-rw-r--r--lisp/ps-print.el27
-rw-r--r--lisp/select.el83
-rw-r--r--lisp/ses.el2
-rw-r--r--lisp/simple.el3
-rw-r--r--lisp/subr.el71
-rw-r--r--lisp/term/w32-win.el6
-rw-r--r--lisp/term/x-win.el5
-rw-r--r--lisp/textmodes/bibtex.el525
-rw-r--r--lisp/toolbar/tool-bar.el9
-rw-r--r--lisp/wdired.el7
-rw-r--r--lisp/winner.el10
-rw-r--r--lisp/xml.el2
32 files changed, 1391 insertions, 1019 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 4b61e5ceabb..a13e786365e 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,273 @@
1
22004-05-07 Juanma Barranquero <lektu@terra.es>
3
4 * emacs-lisp/byte-run.el (make-obsolete, make-obsolete-variable):
5 Make argument names match their use in docstring.
6
7 * subr.el (lambda): Add arglist description to docstring.
8 (declare): Fix typo in docstring.
9 (open-network-stream): Fix docstring.
10 (process-kill-without-query): Fix docstring and add obsolescence
11 info.
12 (last, butlast, nbutlast): Make arguments match their use in docstring.
13 (insert-buffer-substring-no-properties): Likewise.
14 (insert-buffer-substring-as-yank): Likewise.
15 (split-string): Fix docstring.
16
17 * emacs-lisp/re-builder.el (reb-auto-update): Fix typo in docstring.
18
192004-05-06 Nick Roberts <nickrob@gnu.org>
20
21 * progmodes/gdb-ui.el: Improve/extend documentation strings.
22 Fit first sentence on one line for apropos-command.
23
242004-05-06 Stefan Monnier <monnier@iro.umontreal.ca>
25
26 Changes largely merged in from Dave Love's code.
27 * progmodes/python.el: Doc fixes.
28 (python-mode-map): Add python-complete-symbol.
29 (python-comment-line-p, python-beginning-of-string): Use syntax-ppss.
30 (python-comment-indent, python-complete-symbol)
31 (python-symbol-completions, python-partial-symbol)
32 (python-try-complete): New.
33 (python-indent-line): Remove optional arg. Use python-block-end-p.
34 (python-check): Bind compilation-error-regexp-alist.
35 (inferior-python-mode): Use rx. Move keybindings to top level.
36 Set comint-input-filter.
37 (python-preoutput-filter): Use rx.
38 (python-input-filter): Re-introduce.
39 (python-proc): Start new process if necessary.
40 Check python-buffer non-nil.
41 (view-return-to-alist): Defvar.
42 (python-send-receive): New.
43 (python-eldoc-function): Use it.
44 (python-mode-running): Don't defvar.
45 (python-mode): Set comment-indent-function.
46 Maybe update hippie-expand-try-functions-list.
47 (python-indentation-levels): Initialize differently.
48 (python-block-end-p): New.
49 (python-indent-line): Use it.
50 (python-compilation-regexp-alist): Augment.
51 (run-python): Import `emacs' module to Python rather than loading
52 code directly. Set python-buffer differently.
53 (python-send-region): Use emacs.eexecfile. Fix orig-start calculation.
54 Use python-proc.
55 (python-send-command): Go to end of comint buffer.
56 (python-load-file): Use python-proc, emacs.eimport.
57 (python-describe-symbol): Simplify interactive form.
58 Use emacs.help. Do use temp-buffer-show-hook.
59 Call print-help-return-message.
60 (hippie-exp): Require when compiling.
61 (python-preoutput-continuation): Use rx.
62
63 * diff-mode.el (diff-make-unified): Fix regexp.
64
652004-05-06 Romain Francoise <romain@orebokech.com> (tiny change)
66
67 * ibuffer.el (ibuffer-redisplay-engine): Do not remove folded
68 filter groups from the buffer when rebuilding the Ibuffer buffer
69 and `ibuffer-show-empty-filter-groups' is nil.
70
712004-05-06 Vinicius Jose Latorre <viniciusjl@ig.com.br>
72
73 * ps-print.el (ps-print-quote): Call ps-value-string.
74 (ps-setup): Call ps-comment-string.
75 (ps-value-string, ps-comment-string): New funs.
76
772004-05-06 Juanma Barranquero <lektu@terra.es>
78
79 * help-fns.el (help-argument-name): Default to bold; don't inherit
80 from font-lock-variable-name-face.
81 (help-do-arg-highlight): Grok also ARGth occurrences in the docstring.
82
83 * ehelp.el (electric-help-command-loop): Check whether the last
84 character is visible, not (point-max).
85
862004-05-05 Kenichi Handa <handa@m17n.org>
87
88 * descr-text.el (describe-char): Copy the character with text
89 properties and overlays into the first line, and call
90 describe-text-properties on it.
91
922004-05-05 Stephen Eglen <stephen@anc.ed.ac.uk>
93
94 * iswitchb.el (iswitchb-global-map): Fix typo.
95 Remove unwanted ###autoloads from source file.
96
972004-05-05 Lars Hansen <larsh@math.ku.dk>
98
99 * wdired.el (wdired-change-to-wdired-mode): Quote wdired-mode-hook
100 in run-hooks. Use substitute-command-keys in message.
101 (wdired-abort-changes): Add message.
102
1032004-05-03 Michael Mauger <mmaug@yahoo.com>
104
105 * emacs/lisp/progmodes/sql.el (sql-xemacs-p, sql-emacs19-p)
106 (sql-emacs20-p): Remove.
107 (sql-mode-syntax-table): Use shared GNU EMacs/XEmacs syntax.
108 (sql-builtin-face, sql-doc-face): Remove.
109 (sql-mode-ansi-font-lock-keywords)
110 (sql-mode-oracle-font-lock-keywords)
111 (sql-mode-postgres-font-lock-keywords)
112 (sql-mode-linter-font-lock-keywords)
113 (sql-mode-ms-font-lock-keywords)
114 (sql-mode-mysql-font-lock-keywords): Use standard fonts.
115 (sql-product-font-lock): Fix font-lock reset when font rules change.
116 (sql-highlight-product): Remove incorrect font-lock reset logic.
117
1182004-05-04 Jonathan Yavner <jyavner@member.fsf.org>
119
120 * ses.el (ses-set-parameter): Fix typo.
121
1222004-05-04 Kim F. Storm <storm@cua.dk>
123
124 * ido.el (ido-read-internal): Fix call to read-file-name for edit.
125 Must expand directory for completion to work; and don't mess with
126 process-environment.
127 (ido-read-file-name): If command has ido property, don't use ido
128 if value is ignore, or read as directory if value is dir.
129 Set ido ignore property for dired-do-rename command.
130
1312004-05-04 Juanma Barranquero <lektu@terra.es>
132
133 * help-fns.el (help-argument-name): New face, inheriting from
134 font-lock-variable-name-face, to highlight function arguments in
135 `describe-function' and `describe-key'.
136 (help-do-arg-highlight): Auxiliary function to highlight a given
137 list of arguments in a string.
138 (help-highlight-arguments): Highlight the function arguments and
139 all uses of them in the docstring.
140 (describe-function-1): Use it. Do docstring output via `insert',
141 not 'princ', so text attributes are preserved.
142
143 * winner.el (winner-mode-map): Move winner-undo and winner-redo to
144 C-c <left> and C-c <right>, respectively (the previous bindings
145 conflict with prev-buffer, next-buffer).
146
147 * ehelp.el (electric-help-command-loop, electric-help-undefined)
148 (electric-help-help): Check against unmapped commands.
149
1502004-05-03 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
151
152 * textmodes/bibtex.el (bibtex-progress-message): Fix docstring.
153 (bibtex-entry-update): New command bound to C-c C-u.
154 (bibtex-text-in-string): Fix regexp.
155 (bibtex-assoc-of-regexp): Remove.
156 (bibtex-progress-message): Fix docstring.
157 (bibtex-inside-field): Use if.
158 (bibtex-assoc-regexp): New function.
159 (bibtex-format-entry): Make code more robust so that it formats
160 also old entries.
161 (bibtex-autokey-demangle-title): Merge with obsolete function
162 bibtex-assoc-of-regexp.
163 (bibtex-field-list): New function.
164 (bibtex-entry): Use bibtex-field-list.
165 (bibtex-parse-entry): Fix docstring.
166 (bibtex-print-help-message): Use bibtex-field-list.
167 (bibtex-make-field): Use bibtex-field-list.
168 (bibtex-entry-index): Bugfix. Return crossref key if required.
169 (bibtex-lessp): Fix docstring.
170
1712004-05-03 Luc Teirlinck <teirllm@auburn.edu>
172
173 * select.el (xselect-convert-to-string): Move comment to intended line.
174
1752004-05-03 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
176
177 * toolbar/tool-bar.el (tool-bar-setup): Use lookup-key for
178 cut/copy/paste in case menu-bar-enable-clipboard is in effect.
179
1802004-05-03 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
181
182 * term/x-win.el (x-clipboard-yank): Don't exit on error from
183 x-get-selection.
184
1852004-05-03 Jason Rumney <jasonr@gnu.org>
186
187 * makefile.nt: Remove.
188
1892004-05-03 Kim F. Storm <storm@cua.dk>
190
191 * emulation/cua-base.el (cua--update-indications): Fix last change.
192 (cua-mode): Deactivate mark when cua-mode is enabled.
193
1942004-05-02 Luc Teirlinck <teirllm@auburn.edu>
195
196 * select.el (xselect-convert-to-string): Bind `inhibit-read-only' to t.
197
1982004-05-03 Nick Roberts <nickrob@gnu.org>
199
200 * progmodes/gdb-ui.el (gud-watch, gdb-display-buffer)
201 (gdb-display-source-buffer, gdb-put-breakpoint-icon)
202 (gdb-remove-breakpoint-icons, gdb-assembler-custom): Look for
203 window over visible frames.
204 (gdb-goto-breakpoint): Make buffer display file at breakpoint.
205
2062004-05-02 Stefan Monnier <monnier@iro.umontreal.ca>
207
208 * progmodes/compile.el (compilation-gcpro): New var.
209 (compilation-fake-loc): Use it.
210 (compilation-forget-errors): Reset it.
211
2122004-05-02 Dan Nicolaescu <dann@ics.uci.edu>
213
214 * diff-mode.el (diff-header-face, diff-file-header-face):
215 Use min-colors.
216
2172004-05-02 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de>
218
219 * textmodes/bibtex.el (bibtex-sort-buffer): Remove error message.
220 (bibtex-clean-entry): Disentangle code.
221 (bibtex-realign): New function.
222 (bibtex-reformat): Use mapcar and bibtex-realign. Do not use
223 bibtex-beginning-of-first-entry and bibtex-skip-to-valid-entry.
224 Remove undocumented optional arg called-by-convert-alien.
225 (bibtex-convert-alien): Use bibtex-realign. Use bibtex-reformat
226 for sorting instead of bibtex-sort-buffer.
227
2282004-05-02 Eli Zaretskii <eliz@gnu.org>
229
230 * progmodes/compile.el (compilation-start): In the
231 no-async-subprocesses branch, call sit-for to give redisplay a
232 chance to show the updated process status in the mode line, and
233 fontify the buffer explicitly after the process exits.
234
2352004-05-01 Stefan Monnier <monnier@iro.umontreal.ca>
236
237 * progmodes/python.el (python-compilation-line-number): Remove.
238 (python-compilation-regexp-alist): Don't use it any more.
239 (python-orig-start, python-input-filter): Remove.
240 (inferior-python-mode): Don't set up comint-input-filter-functions.
241 (python-send-region): Use compilation-fake-loc.
242
243 * progmodes/compile.el (compilation-messages-start): New var.
244 (compilation-mode): Don't setup next-error-function here.
245 (compilation-setup): Set it up here instead (for minor modes as well).
246 Make compilation-messages-start buffer local.
247 (compilation-next-error-function): Use it.
248 (compilation-forget-errors): Set compilation-messages-start.
249
2502004-05-01 Luc Teirlinck <teirllm@auburn.edu>
251
252 * ielm.el (ielm-prompt-read-only): Update docstring.
253
254 * comint.el (comint-prompt-read-only): Update docstring.
255 (comint-update-fence, comint-kill-whole-line)
256 (comint-kill-region): New functions.
257
258 * simple.el (kill-whole-line): Use "p" instead of "P" in
259 interactive form.
260
2612004-05-01 Juanma Barranquero <lektu@terra.es>
262
263 * help-fns.el (help-add-fundoc-usage): Use %S instead of %s to
264 format arglist so default values in CL-style argument lists are
265 correctly shown.
266
2672004-05-01 Jason Rumney <jasonr@gnu.org>
268
269 * term/w32-win.el (w32-drag-n-drop): Use x-dnd.el functions.
270
12004-05-01 Kenichi Handa <handa@m17n.org> 2712004-05-01 Kenichi Handa <handa@m17n.org>
2 272
3 * international/titdic-cnv.el (miscdic-convert): Don't generate a 273 * international/titdic-cnv.el (miscdic-convert): Don't generate a
@@ -35,7 +305,7 @@
35 * delsel.el: Don't put `delete-selection' property 305 * delsel.el: Don't put `delete-selection' property
36 on `insert-parentheses' symbol to take advantage of 306 on `insert-parentheses' symbol to take advantage of
37 region handling in `insert-pair' function. 307 region handling in `insert-pair' function.
38 Suggested by Stephan Stahl <stahl@eos.franken.de> 308 Suggested by Stephan Stahl <stahl@eos.franken.de>.
39 309
402004-04-30 Kim F. Storm <storm@cua.dk> 3102004-04-30 Kim F. Storm <storm@cua.dk>
41 311
@@ -65,7 +335,7 @@
65 New defmacro. 335 New defmacro.
66 (cua-upcase-rectangle, cua-downcase-rectangle): Use it. 336 (cua-upcase-rectangle, cua-downcase-rectangle): Use it.
67 (cua-upcase-initials-rectangle, cua-capitalize-rectangle): 337 (cua-upcase-initials-rectangle, cua-capitalize-rectangle):
68 New commands (suggested by Jordan Breeding).. 338 New commands (suggested by Jordan Breeding).
69 339
702004-04-30 Juanma Barranquero <lektu@terra.es> 3402004-04-30 Juanma Barranquero <lektu@terra.es>
71 341
@@ -5779,7 +6049,7 @@
57792003-08-12 Juri Linkov <juri@jurta.org> (tiny change) 60492003-08-12 Juri Linkov <juri@jurta.org> (tiny change)
5780 6050
5781 * simple.el (backward-word, forward-to-indentation) 6051 * simple.el (backward-word, forward-to-indentation)
5782 (backward-to-indentation): Argument changed to optional. 6052 (backward-to-indentation): Argument changed to optional.
5783 (next-line, previous-line): Use `or' instead of `unless'. 6053 (next-line, previous-line): Use `or' instead of `unless'.
5784 6054
57852003-08-12 Vinicius Jose Latorre <viniciusjl@ig.com.br> 60552003-08-12 Vinicius Jose Latorre <viniciusjl@ig.com.br>
@@ -5961,7 +6231,7 @@
5961 behaviour of `calendar-day-name' and `calendar-month-name' functions. 6231 behaviour of `calendar-day-name' and `calendar-month-name' functions.
5962 (diary-name-pattern): Use abbrev arrays, rather than fixing 6232 (diary-name-pattern): Use abbrev arrays, rather than fixing
5963 abbrevs at three chars. Calling syntax change. 6233 abbrevs at three chars. Calling syntax change.
5964 (mark-diary-entries): Adapt for new behaviours of 6234 (mark-diary-entries): Adapt for new behaviours of
5965 `diary-name-pattern' and `calendar-make-alist' functions. 6235 `diary-name-pattern' and `calendar-make-alist' functions.
5966 (fancy-diary-font-lock-keywords): Adapt for new behaviour of 6236 (fancy-diary-font-lock-keywords): Adapt for new behaviour of
5967 `diary-name-pattern' function. 6237 `diary-name-pattern' function.
@@ -6412,7 +6682,7 @@
6412 6682
64132003-07-08 Markus Rost <rost@math.ohio-state.edu> 66832003-07-08 Markus Rost <rost@math.ohio-state.edu>
6414 6684
6415 * subr.el (dolist, dotimes): Doc fix. 6685 * subr.el (dolist, dotimes): Doc fix.
6416 6686
64172003-07-08 Kim F. Storm <storm@cua.dk> 66872003-07-08 Kim F. Storm <storm@cua.dk>
6418 6688
diff --git a/lisp/comint.el b/lisp/comint.el
index 52217fa8ad6..c5e903fc58f 100644
--- a/lisp/comint.el
+++ b/lisp/comint.el
@@ -173,8 +173,25 @@ This is a good thing to set in mode hooks.")
173 173
174(defcustom comint-prompt-read-only nil 174(defcustom comint-prompt-read-only nil
175 "If non-nil, the comint prompt is read only. 175 "If non-nil, the comint prompt is read only.
176The read only region includes the newline before the prompt.
176This does not affect existing prompts. 177This does not affect existing prompts.
177Certain derived modes may override this option." 178Certain derived modes may override this option.
179
180If you set this option to t, then the safe way to temporarily
181override the read-only-ness of comint prompts is to call
182`comint-kill-whole-line' or `comint-kill-region' with no
183narrowing in effect. This way you will be certain that none of
184the remaining prompts will be accidentally messed up. You may
185wish to put something like the following in your `.emacs' file:
186
187\(add-hook 'comint-mode-hook
188 '(lambda ()
189 (define-key comint-mode-map \"\C-w\" 'comint-kill-region)
190 (define-key comint-mode-map [C-S-backspace]
191 'comint-kill-whole-line)))
192
193If you sometimes use comint-mode on text-only terminals or with `emacs-nw',
194you might wish to use another binding for `comint-kill-whole-line'."
178 :type 'boolean 195 :type 'boolean
179 :group 'comint 196 :group 'comint
180 :version "21.4") 197 :version "21.4")
@@ -2311,6 +2328,83 @@ This command is like `M-.' in bash."
2311 (just-one-space))) 2328 (just-one-space)))
2312 2329
2313 2330
2331;; Support editing with `comint-prompt-read-only' set to t.
2332
2333(defun comint-update-fence ()
2334 "Update read-only status of newline before point.
2335The `fence' read-only property is used to indicate that a newline
2336is read-only for no other reason than to \"fence off\" a
2337following front-sticky read-only region. This is used to
2338implement comint read-only prompts. If the text after a newline
2339changes, the read-only status of that newline may need updating.
2340That is what this function does.
2341
2342This function does nothing if point is not at the beginning of a
2343line, or is at the beginning of the accessible portion of the buffer.
2344Otherwise, if the character after point has a front-sticky
2345read-only property, then the preceding newline is given a
2346read-only property of `fence', unless it already is read-only.
2347If the character after point does not have a front-sticky
2348read-only property, any read-only property of `fence' on the
2349preceding newline is removed."
2350 (let* ((pt (point)) (lst (get-text-property pt 'front-sticky)))
2351 (and (bolp)
2352 (not (bobp))
2353 (if (and (get-text-property pt 'read-only)
2354 (if (listp lst) (memq 'read-only lst) t))
2355 (unless (get-text-property (1- pt) 'read-only)
2356 (put-text-property (1- pt) pt 'read-only 'fence))
2357 (when (eq (get-text-property (1- pt) 'read-only) 'fence)
2358 (remove-list-of-text-properties (1- pt) pt '(read-only)))))))
2359
2360(defun comint-kill-whole-line (&optional arg)
2361 "Kill current line, ignoring read-only and field properties.
2362With prefix arg, kill that many lines starting from the current line.
2363If arg is negative, kill backward. Also kill the preceding newline,
2364instead of the trailing one. \(This is meant to make C-x z work well
2365with negative arguments.)
2366If arg is zero, kill current line but exclude the trailing newline.
2367The read-only status of newlines is updated with `comint-update-fence',
2368if necessary."
2369 (interactive "p")
2370 (let ((inhibit-read-only t) (inhibit-field-text-motion t))
2371 (kill-whole-line arg)
2372 (when (>= arg 0) (comint-update-fence))))
2373
2374(defun comint-kill-region (beg end &optional yank-handler)
2375 "Like `kill-region', but ignores read-only properties, if safe.
2376This command assumes that the buffer contains read-only
2377\"prompts\" which are regions with front-sticky read-only
2378properties at the beginning of a line, with the preceding newline
2379being read-only to protect the prompt. This is true of the
2380comint prompts if `comint-prompt-read-only' is non-nil. This
2381command will not delete the region if this would create mutilated
2382or out of place prompts. That is, if any part of a prompt is
2383deleted, the entire prompt must be deleted and all remaining
2384prompts should stay at the beginning of a line. If this is not
2385the case, this command just calls `kill-region' with all
2386read-only properties intact. The read-only status of newlines is
2387updated using `comint-update-fence', if necessary."
2388 (interactive "r")
2389 (save-excursion
2390 (let* ((true-beg (min beg end))
2391 (true-end (max beg end))
2392 (beg-bolp (progn (goto-char true-beg) (bolp)))
2393 (beg-lst (get-text-property true-beg 'front-sticky))
2394 (beg-bad (and (get-text-property true-beg 'read-only)
2395 (if (listp beg-lst) (memq 'read-only beg-lst) t)))
2396 (end-bolp (progn (goto-char true-end) (bolp)))
2397 (end-lst (get-text-property true-end 'front-sticky))
2398 (end-bad (and (get-text-property true-end 'read-only)
2399 (if (listp end-lst) (memq 'read-only end-lst) t))))
2400 (if (or (and (not beg-bolp) (or beg-bad end-bad))
2401 (and (not end-bolp) end-bad))
2402 (kill-region beg end yank-handler)
2403 (let ((inhibit-read-only t))
2404 (kill-region beg end yank-handler)
2405 (comint-update-fence))))))
2406
2407
2314;; Support for source-file processing commands. 2408;; Support for source-file processing commands.
2315;;============================================================================ 2409;;============================================================================
2316;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have 2410;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
diff --git a/lisp/descr-text.el b/lisp/descr-text.el
index c73cfeb02c3..4b6605aa426 100644
--- a/lisp/descr-text.el
+++ b/lisp/descr-text.el
@@ -465,6 +465,7 @@ as well as widgets, buttons, overlays, and text properties."
465 (if (>= pos (point-max)) 465 (if (>= pos (point-max))
466 (error "No character follows specified position")) 466 (error "No character follows specified position"))
467 (let* ((char (char-after pos)) 467 (let* ((char (char-after pos))
468 (char-string (buffer-substring pos (1+ pos)))
468 (charset (char-charset char)) 469 (charset (char-charset char))
469 (buffer (current-buffer)) 470 (buffer (current-buffer))
470 (composition (find-composition pos nil nil t)) 471 (composition (find-composition pos nil nil t))
@@ -474,16 +475,11 @@ as well as widgets, buttons, overlays, and text properties."
474 standard-display-table)) 475 standard-display-table))
475 (disp-vector (and display-table (aref display-table char))) 476 (disp-vector (and display-table (aref display-table char)))
476 (multibyte-p enable-multibyte-characters) 477 (multibyte-p enable-multibyte-characters)
477 text-prop-description 478 (overlays (mapcar #'(lambda (o) (overlay-properties o))
479 (overlays-at pos)))
478 item-list max-width unicode) 480 item-list max-width unicode)
479 (if (eq charset 'unknown) 481 (if (eq charset 'unknown)
480 (setq item-list 482 (setq item-list '("character"))
481 `(("character"
482 ,(format "%s (0%o, %d, 0x%x) -- invalid character code"
483 (if (< char 256)
484 (single-key-description char)
485 (char-to-string char))
486 char char char))))
487 483
488 (if (or (< char 256) 484 (if (or (< char 256)
489 (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos))) 485 (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos)))
@@ -491,14 +487,7 @@ as well as widgets, buttons, overlays, and text properties."
491 (setq unicode (or (get-char-property pos 'untranslated-utf-8) 487 (setq unicode (or (get-char-property pos 'untranslated-utf-8)
492 (encode-char char 'ucs)))) 488 (encode-char char 'ucs))))
493 (setq item-list 489 (setq item-list
494 `(("character" 490 `(("character")
495 ,(format "%s (0%o, %d, 0x%x%s)" (if (< char 256)
496 (single-key-description char)
497 (char-to-string char))
498 char char char
499 (if unicode
500 (format ", U+%04X" unicode)
501 "")))
502 ("charset" 491 ("charset"
503 ,(symbol-name charset) 492 ,(symbol-name charset)
504 ,(format "(%s)" (charset-description charset))) 493 ,(format "(%s)" (charset-description charset)))
@@ -583,18 +572,31 @@ as well as widgets, buttons, overlays, and text properties."
583 (cons (list "Unicode data" " ") unicodedata)))))) 572 (cons (list "Unicode data" " ") unicodedata))))))
584 (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) 573 (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
585 item-list))) 574 item-list)))
586 (setq text-prop-description 575 (pop item-list)
587 (with-temp-buffer
588 (let ((buf (current-buffer)))
589 (save-excursion
590 (set-buffer buffer)
591 (describe-text-properties pos buf)))
592 (buffer-string)))
593 576
594 (with-output-to-temp-buffer "*Help*" 577 (with-output-to-temp-buffer "*Help*"
595 (with-current-buffer standard-output 578 (with-current-buffer standard-output
596 (set-buffer-multibyte multibyte-p) 579 (set-buffer-multibyte multibyte-p)
597 (let ((formatter (format "%%%ds:" max-width))) 580 (let ((formatter (format "%%%ds:" max-width)))
581 (insert (format formatter "character") " ")
582 (setq pos (point))
583 (insert char-string
584 (format " (`%s', 0%o, %d, 0x%x"
585 (if (< char 256)
586 (single-key-description char)
587 (char-to-string char))
588 char char char)
589 (if (eq charset 'unknown)
590 ") -- invalid character code\n"
591 (if unicode
592 (format ", U+%04X)\n" unicode)
593 ")\n")))
594 (mapc #'(lambda (props)
595 (let ((o (make-overlay pos (1+ pos))))
596 (while props
597 (overlay-put o (car props) (nth 1 props))
598 (setq props (cddr props)))))
599 overlays)
598 (dolist (elt item-list) 600 (dolist (elt item-list)
599 (when (cadr elt) 601 (when (cadr elt)
600 (insert (format formatter (car elt))) 602 (insert (format formatter (car elt)))
@@ -665,7 +667,7 @@ as well as widgets, buttons, overlays, and text properties."
665 (insert "\nSee the variable `reference-point-alist' for " 667 (insert "\nSee the variable `reference-point-alist' for "
666 "the meaning of the rule.\n")) 668 "the meaning of the rule.\n"))
667 669
668 (insert text-prop-description) 670 (describe-text-properties pos (current-buffer))
669 (describe-text-mode))))) 671 (describe-text-mode)))))
670 672
671(defalias 'describe-char-after 'describe-char) 673(defalias 'describe-char-after 'describe-char)
diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el
index 17602317958..9b00eae050d 100644
--- a/lisp/diff-mode.el
+++ b/lisp/diff-mode.el
@@ -169,27 +169,27 @@ when editing big diffs)."
169;;;; 169;;;;
170 170
171(defface diff-header-face 171(defface diff-header-face
172 '((((type tty pc) (class color) (background light)) 172 '((((class color) (min-colors 88) (background light))
173 (:foreground "blue1" :weight bold))
174 (((type tty pc) (class color) (background dark))
175 (:foreground "green" :weight bold))
176 (((class color) (background light))
177 (:background "grey85")) 173 (:background "grey85"))
178 (((class color) (background dark)) 174 (((class color) (min-colors 88) (background dark))
179 (:background "grey45")) 175 (:background "grey45"))
176 (((class color) (background light))
177 (:foreground "blue1" :weight bold))
178 (((class color) (background dark))
179 (:foreground "green" :weight bold))
180 (t (:weight bold))) 180 (t (:weight bold)))
181 "`diff-mode' face inherited by hunk and index header faces.") 181 "`diff-mode' face inherited by hunk and index header faces.")
182(defvar diff-header-face 'diff-header-face) 182(defvar diff-header-face 'diff-header-face)
183 183
184(defface diff-file-header-face 184(defface diff-file-header-face
185 '((((type tty pc) (class color) (background light)) 185 '((((class color) (min-colors 88) (background light))
186 (:foreground "yellow" :weight bold))
187 (((type tty pc) (class color) (background dark))
188 (:foreground "cyan" :weight bold))
189 (((class color) (background light))
190 (:background "grey70" :weight bold)) 186 (:background "grey70" :weight bold))
191 (((class color) (background dark)) 187 (((class color) (min-colors 88) (background dark))
192 (:background "grey60" :weight bold)) 188 (:background "grey60" :weight bold))
189 (((class color) (background light))
190 (:foreground "yellow" :weight bold))
191 (((class color) (background dark))
192 (:foreground "cyan" :weight bold))
193 (t (:weight bold))) ; :height 1.3 193 (t (:weight bold))) ; :height 1.3
194 "`diff-mode' face used to highlight file header lines.") 194 "`diff-mode' face used to highlight file header lines.")
195(defvar diff-file-header-face 'diff-file-header-face) 195(defvar diff-file-header-face 'diff-file-header-face)
@@ -976,7 +976,7 @@ a diff with \\[diff-reverse-direction]."
976 "Turn context diffs into unified diffs if applicable." 976 "Turn context diffs into unified diffs if applicable."
977 (if (save-excursion 977 (if (save-excursion
978 (goto-char (point-min)) 978 (goto-char (point-min))
979 (looking-at "\\*\\*\\* ")) 979 (and (looking-at diff-hunk-header-re) (eq (char-after) ?*)))
980 (let ((mod (buffer-modified-p))) 980 (let ((mod (buffer-modified-p)))
981 (unwind-protect 981 (unwind-protect
982 (diff-context->unified (point-min) (point-max)) 982 (diff-context->unified (point-min) (point-max))
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
index 12ebbeb0c0d..e80c129d3ea 100644
--- a/lisp/ehelp.el
+++ b/lisp/ehelp.el
@@ -1,6 +1,6 @@
1;;; ehelp.el --- bindings for electric-help mode 1;;; ehelp.el --- bindings for electric-help mode
2 2
3;; Copyright (C) 1986, 1995, 2000, 2001 Free Software Foundation, Inc. 3;; Copyright (C) 1986, 1995, 2000, 2001, 2004 Free Software Foundation, Inc.
4 4
5;; Maintainer: FSF 5;; Maintainer: FSF
6;; Keywords: help, extensions 6;; Keywords: help, extensions
@@ -200,13 +200,13 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
200 (progn (setq unread-command-events nil) 200 (progn (setq unread-command-events nil)
201 (throw 'exit t))))) 201 (throw 'exit t)))))
202 (let (up down both neither 202 (let (up down both neither
203 (standard (and (eq (key-binding " ") 203 (standard (and (eq (key-binding " " nil t)
204 'scroll-up) 204 'scroll-up)
205 (eq (key-binding "\^?") 205 (eq (key-binding "\^?" nil t)
206 'scroll-down) 206 'scroll-down)
207 (eq (key-binding "q") 207 (eq (key-binding "q" nil t)
208 'electric-help-exit) 208 'electric-help-exit)
209 (eq (key-binding "r") 209 (eq (key-binding "r" nil t)
210 'electric-help-retain)))) 210 'electric-help-retain))))
211 (Electric-command-loop 211 (Electric-command-loop
212 'exit 212 'exit
@@ -215,7 +215,7 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
215 ;beginning-of-buffer - otherwise pos-visible-in-window-p 215 ;beginning-of-buffer - otherwise pos-visible-in-window-p
216 ;will yield a wrong result. 216 ;will yield a wrong result.
217 (let ((min (pos-visible-in-window-p (point-min))) 217 (let ((min (pos-visible-in-window-p (point-min)))
218 (max (pos-visible-in-window-p (point-max)))) 218 (max (pos-visible-in-window-p (1- (point-max)))))
219 (cond (isearch-mode 'noprompt) 219 (cond (isearch-mode 'noprompt)
220 ((and min max) 220 ((and min max)
221 (cond (standard "Press q to exit, r to retain ") 221 (cond (standard "Press q to exit, r to retain ")
@@ -272,7 +272,7 @@ will select it.)"
272 (interactive) 272 (interactive)
273 (error "%s is undefined -- Press %s to exit" 273 (error "%s is undefined -- Press %s to exit"
274 (mapconcat 'single-key-description (this-command-keys) " ") 274 (mapconcat 'single-key-description (this-command-keys) " ")
275 (if (eq (key-binding "q") 'electric-help-exit) 275 (if (eq (key-binding "q" nil t) 'electric-help-exit)
276 "q" 276 "q"
277 (substitute-command-keys "\\[electric-help-exit]")))) 277 (substitute-command-keys "\\[electric-help-exit]"))))
278 278
@@ -280,10 +280,10 @@ will select it.)"
280;>>> this needs to be hairified (recursive help, anybody?) 280;>>> this needs to be hairified (recursive help, anybody?)
281(defun electric-help-help () 281(defun electric-help-help ()
282 (interactive) 282 (interactive)
283 (if (and (eq (key-binding "q") 'electric-help-exit) 283 (if (and (eq (key-binding "q" nil t) 'electric-help-exit)
284 (eq (key-binding " ") 'scroll-up) 284 (eq (key-binding " " nil t) 'scroll-up)
285 (eq (key-binding "\^?") 'scroll-down) 285 (eq (key-binding "\^?" nil t) 'scroll-down)
286 (eq (key-binding "r") 'electric-help-retain)) 286 (eq (key-binding "r" nil t) 'electric-help-retain))
287 (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits") 287 (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits")
288 (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits"))) 288 (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits")))
289 (sit-for 2)) 289 (sit-for 2))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 4ed47129fc9..2cd0896c835 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -76,21 +76,21 @@
76 (eval-and-compile 76 (eval-and-compile
77 (put ',name 'byte-optimizer 'byte-compile-inline-expand)))) 77 (put ',name 'byte-optimizer 'byte-compile-inline-expand))))
78 78
79(defun make-obsolete (fn new &optional when) 79(defun make-obsolete (function new &optional when)
80 "Make the byte-compiler warn that FUNCTION is obsolete. 80 "Make the byte-compiler warn that FUNCTION is obsolete.
81The warning will say that NEW should be used instead. 81The warning will say that NEW should be used instead.
82If NEW is a string, that is the `use instead' message. 82If NEW is a string, that is the `use instead' message.
83If provided, WHEN should be a string indicating when the function 83If provided, WHEN should be a string indicating when the function
84was first made obsolete, for example a date or a release number." 84was first made obsolete, for example a date or a release number."
85 (interactive "aMake function obsolete: \nxObsoletion replacement: ") 85 (interactive "aMake function obsolete: \nxObsoletion replacement: ")
86 (let ((handler (get fn 'byte-compile))) 86 (let ((handler (get function 'byte-compile)))
87 (if (eq 'byte-compile-obsolete handler) 87 (if (eq 'byte-compile-obsolete handler)
88 (setq handler (nth 1 (get fn 'byte-obsolete-info))) 88 (setq handler (nth 1 (get function 'byte-obsolete-info)))
89 (put fn 'byte-compile 'byte-compile-obsolete)) 89 (put function 'byte-compile 'byte-compile-obsolete))
90 (put fn 'byte-obsolete-info (list new handler when))) 90 (put function 'byte-obsolete-info (list new handler when)))
91 fn) 91 function)
92 92
93(defun make-obsolete-variable (var new &optional when) 93(defun make-obsolete-variable (variable new &optional when)
94 "Make the byte-compiler warn that VARIABLE is obsolete. 94 "Make the byte-compiler warn that VARIABLE is obsolete.
95The warning will say that NEW should be used instead. 95The warning will say that NEW should be used instead.
96If NEW is a string, that is the `use instead' message. 96If NEW is a string, that is the `use instead' message.
@@ -102,8 +102,8 @@ was first made obsolete, for example a date or a release number."
102 (if (equal str "") (error "")) 102 (if (equal str "") (error ""))
103 (intern str)) 103 (intern str))
104 (car (read-from-string (read-string "Obsoletion replacement: "))))) 104 (car (read-from-string (read-string "Obsoletion replacement: ")))))
105 (put var 'byte-obsolete-variable (cons new when)) 105 (put variable 'byte-obsolete-variable (cons new when))
106 var) 106 variable)
107 107
108(put 'dont-compile 'lisp-indent-hook 0) 108(put 'dont-compile 'lisp-indent-hook 0)
109(defmacro dont-compile (&rest body) 109(defmacro dont-compile (&rest body)
diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el
index 9c904e6c0bc..83d3649006e 100644
--- a/lisp/emacs-lisp/re-builder.el
+++ b/lisp/emacs-lisp/re-builder.el
@@ -494,7 +494,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions."
494 494
495(defun reb-auto-update (beg end lenold &optional force) 495(defun reb-auto-update (beg end lenold &optional force)
496 "Called from `after-update-functions' to update the display. 496 "Called from `after-update-functions' to update the display.
497BEG END and LENOLD are passed in from the hook. 497BEG, END and LENOLD are passed in from the hook.
498An actual update is only done if the regexp has changed or if the 498An actual update is only done if the regexp has changed or if the
499optional fourth argument FORCE is non-nil." 499optional fourth argument FORCE is non-nil."
500 (let ((prev-valid reb-valid-string) 500 (let ((prev-valid reb-valid-string)
diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el
index c248dbbdcf2..51b47b104d0 100644
--- a/lisp/emulation/cua-base.el
+++ b/lisp/emulation/cua-base.el
@@ -1039,7 +1039,7 @@ If ARG is the atom `-', scroll upward by nearly full screen."
1039 (set-cursor-color color)) 1039 (set-cursor-color color))
1040 (if (and type 1040 (if (and type
1041 (symbolp type) 1041 (symbolp type)
1042 (not (eq type (frame-parameter nil 'cursor-type)))) 1042 (not (eq type default-cursor-type)))
1043 (setq default-cursor-type type)))) 1043 (setq default-cursor-type type))))
1044 1044
1045 1045
@@ -1336,6 +1336,7 @@ paste (in addition to the normal emacs bindings)."
1336 (delete-selection-mode -1)) 1336 (delete-selection-mode -1))
1337 (if (and (boundp 'pc-selection-mode) pc-selection-mode) 1337 (if (and (boundp 'pc-selection-mode) pc-selection-mode)
1338 (pc-selection-mode -1)) 1338 (pc-selection-mode -1))
1339 (cua--deactivate)
1339 (setq transient-mark-mode (and cua-mode 1340 (setq transient-mark-mode (and cua-mode
1340 (if cua-highlight-region-shift-only 1341 (if cua-highlight-region-shift-only
1341 (not cua--explicit-region-start) 1342 (not cua--explicit-region-start)
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog
index dc39720f79b..ac1bad7e3ab 100644
--- a/lisp/gnus/ChangeLog
+++ b/lisp/gnus/ChangeLog
@@ -1,3 +1,7 @@
12004-05-06 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * nnimap.el (nnimap-demule): Avoid string-as-multibyte.
4
12004-03-27 Juanma Barranquero <lektu@terra.es> 52004-03-27 Juanma Barranquero <lektu@terra.es>
2 6
3 * gnus-srvr.el (gnus-server-prepare): Remove spurious call to `cdr'. 7 * gnus-srvr.el (gnus-server-prepare): Remove spurious call to `cdr'.
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 02cb87af28b..a7cf82317b5 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1,5 +1,6 @@
1;;; nnimap.el --- imap backend for Gnus 1;;; nnimap.el --- imap backend for Gnus
2;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. 2
3;; Copyright (C) 1998,1999,2000,01,02,2004 Free Software Foundation, Inc.
3 4
4;; Author: Simon Josefsson <jas@pdc.kth.se> 5;; Author: Simon Josefsson <jas@pdc.kth.se>
5;; Jim Radford <radford@robby.caltech.edu> 6;; Jim Radford <radford@robby.caltech.edu>
@@ -671,9 +672,12 @@ function is generally only called when Gnus is shutting down."
671 (nnoo-status-message 'nnimap server))) 672 (nnoo-status-message 'nnimap server)))
672 673
673(defun nnimap-demule (string) 674(defun nnimap-demule (string)
674 (funcall (if (and (fboundp 'string-as-multibyte) 675 ;; BEWARE: we used to use string-as-multibyte here which is braindead
675 (subrp (symbol-function 'string-as-multibyte))) 676 ;; because it will turn accidental emacs-mule-valid byte sequences
676 'string-as-multibyte 677 ;; into multibyte chars. --Stef
678 (funcall (if (and (fboundp 'string-to-multibyte)
679 (subrp (symbol-function 'string-to-multibyte)))
680 'string-to-multibyte
677 'identity) 681 'identity)
678 (or string ""))) 682 (or string "")))
679 683
@@ -1383,5 +1387,5 @@ sure of changing the value of `foo'."
1383 1387
1384(provide 'nnimap) 1388(provide 'nnimap)
1385 1389
1386;;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b 1390;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b
1387;;; nnimap.el ends here 1391;;; nnimap.el ends here
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 4e57ea6d74e..a94c0ed9dea 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -181,7 +181,7 @@ ARGLIST can also be t or a string of the form \"(fun ARG1 ARG2 ...)\"."
181 (unless (stringp doc) (setq doc "Not documented")) 181 (unless (stringp doc) (setq doc "Not documented"))
182 (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc) (eq arglist t)) 182 (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc) (eq arglist t))
183 doc 183 doc
184 (format "%s%s%s" doc 184 (format "%s%s%S" doc
185 (if (string-match "\n?\n\\'" doc) 185 (if (string-match "\n?\n\\'" doc)
186 (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "") 186 (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "")
187 "\n\n") 187 "\n\n")
@@ -237,6 +237,43 @@ KIND should be `var' for a variable or `subr' for a subroutine."
237 (concat "src/" file) 237 (concat "src/" file)
238 file))))) 238 file)))))
239 239
240(defface help-argument-name '((t (:weight bold)))
241 "Face to highlight function arguments in docstrings.")
242
243(defun help-do-arg-highlight (doc args)
244 (while args
245 (let ((arg (prog1 (car args) (setq args (cdr args)))))
246 (setq doc (replace-regexp-in-string
247 (concat "\\<\\(" arg "\\)\\(?:es\\|s\\|th\\)?\\>")
248 (propertize arg 'face 'help-argument-name)
249 doc t t 1))))
250 doc)
251
252(defun help-highlight-arguments (usage doc &rest args)
253 (when usage
254 (let ((case-fold-search nil)
255 (next (not args)))
256 ;; Make a list of all arguments
257 (with-temp-buffer
258 (insert usage)
259 (goto-char (point-min))
260 ;; Make a list of all arguments
261 (while next
262 (if (not (re-search-forward " \\([\\[(]?\\)\\([^] &)\.]+\\)" nil t))
263 (setq next nil)
264 (setq args (cons (match-string 2) args))
265 (when (string= (match-string 1) "(")
266 ;; A pesky CL-style optional argument with default value,
267 ;; so let's skip over it
268 (search-backward "(")
269 (goto-char (scan-sexps (point) 1)))))
270 ;; Highlight aguments in the USAGE string
271 (setq usage (help-do-arg-highlight (buffer-string) args)))
272 ;; Highlight arguments in the DOC string
273 (setq doc (and doc (help-do-arg-highlight doc args)))
274 ;; Return value is like the one from help-split-fundoc, but highlighted
275 (cons usage doc))))
276
240;;;###autoload 277;;;###autoload
241(defun describe-function-1 (function) 278(defun describe-function-1 (function)
242 (let* ((def (if (symbolp function) 279 (let* ((def (if (symbolp function)
@@ -339,7 +376,7 @@ KIND should be `var' for a variable or `subr' for a subroutine."
339 ;; FIXME: This list can be very long (f.ex. for self-insert-command). 376 ;; FIXME: This list can be very long (f.ex. for self-insert-command).
340 ;; If there are many, remove them from KEYS. 377 ;; If there are many, remove them from KEYS.
341 (if (< (length non-modified-keys) 10) 378 (if (< (length non-modified-keys) 10)
342 (princ (mapconcat 'key-description keys ", ")) 379 (princ (mapconcat 'key-description keys ", "))
343 (dolist (key non-modified-keys) 380 (dolist (key non-modified-keys)
344 (setq keys (delq key keys))) 381 (setq keys (delq key keys)))
345 (if keys 382 (if keys
@@ -353,40 +390,44 @@ KIND should be `var' for a variable or `subr' for a subroutine."
353 (let* ((arglist (help-function-arglist def)) 390 (let* ((arglist (help-function-arglist def))
354 (doc (documentation function)) 391 (doc (documentation function))
355 (usage (help-split-fundoc doc function))) 392 (usage (help-split-fundoc doc function)))
356 ;; If definition is a keymap, skip arglist note. 393 (with-current-buffer standard-output
357 (unless (keymapp def) 394 ;; If definition is a keymap, skip arglist note.
358 (princ (cond 395 (unless (keymapp def)
359 (usage (setq doc (cdr usage)) (car usage)) 396 (let* ((use (cond
360 ((listp arglist) (help-make-usage function arglist)) 397 (usage (setq doc (cdr usage)) (car usage))
361 ((stringp arglist) arglist) 398 ((listp arglist)
362 ;; Maybe the arglist is in the docstring of the alias. 399 (format "%S" (help-make-usage function arglist)))
363 ((let ((fun function)) 400 ((stringp arglist) arglist)
364 (while (and (symbolp fun) 401 ;; Maybe the arglist is in the docstring of the alias.
365 (setq fun (symbol-function fun)) 402 ((let ((fun function))
366 (not (setq usage (help-split-fundoc 403 (while (and (symbolp fun)
367 (documentation fun) 404 (setq fun (symbol-function fun))
368 function))))) 405 (not (setq usage (help-split-fundoc
369 usage) 406 (documentation fun)
370 (car usage)) 407 function)))))
371 ((or (stringp def) 408 usage)
372 (vectorp def)) 409 (car usage))
373 (format "\nMacro: %s" (format-kbd-macro def))) 410 ((or (stringp def)
374 (t "[Missing arglist. Please make a bug report.]"))) 411 (vectorp def))
375 (terpri)) 412 (format "\nMacro: %s" (format-kbd-macro def)))
376 (let ((obsolete (and 413 (t "[Missing arglist. Please make a bug report.]")))
377 ;; function might be a lambda construct. 414 (high (help-highlight-arguments use doc)))
378 (symbolp function) 415 (insert (car high) "\n")
379 (get function 'byte-obsolete-info)))) 416 (setq doc (cdr high))))
380 (when obsolete 417 (let ((obsolete (and
381 (terpri) 418 ;; function might be a lambda construct.
382 (princ "This function is obsolete") 419 (symbolp function)
383 (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete)))) 420 (get function 'byte-obsolete-info))))
384 (princ ";") (terpri) 421 (when obsolete
385 (princ (if (stringp (car obsolete)) (car obsolete) 422 (princ "\nThis function is obsolete")
386 (format "use `%s' instead." (car obsolete)))) 423 (when (nth 2 obsolete)
387 (terpri))) 424 (insert (format " since %s" (nth 2 obsolete))))
388 (terpri) 425 (insert ";\n"
389 (princ (or doc "Not documented."))))) 426 (if (stringp (car obsolete)) (car obsolete)
427 (format "use `%s' instead." (car obsolete)))
428 "\n"))
429 (insert "\n"
430 (or doc "Not documented.")))))))
390 431
391 432
392;; Variables 433;; Variables
diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el
index a1fd3195d46..ab8290cfae8 100644
--- a/lisp/ibuffer.el
+++ b/lisp/ibuffer.el
@@ -1,6 +1,6 @@
1;;; ibuffer.el --- operate on buffers like dired 1;;; ibuffer.el --- operate on buffers like dired
2 2
3;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. 3;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
4 4
5;; Author: Colin Walters <walters@verbum.org> 5;; Author: Colin Walters <walters@verbum.org>
6;; Maintainer: John Paul Wallington <jpw@gnu.org> 6;; Maintainer: John Paul Wallington <jpw@gnu.org>
@@ -2166,6 +2166,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
2166 (member name ibuffer-hidden-filter-groups))) 2166 (member name ibuffer-hidden-filter-groups)))
2167 (bmarklist (cdr group))) 2167 (bmarklist (cdr group)))
2168 (unless (and (null bmarklist) 2168 (unless (and (null bmarklist)
2169 (not disabled)
2169 ext-loaded 2170 ext-loaded
2170 (null ibuffer-show-empty-filter-groups)) 2171 (null ibuffer-show-empty-filter-groups))
2171 (ibuffer-insert-filter-group 2172 (ibuffer-insert-filter-group
diff --git a/lisp/ido.el b/lisp/ido.el
index 6a66ce0388d..4cbc88cf037 100644
--- a/lisp/ido.el
+++ b/lisp/ido.el
@@ -1,6 +1,6 @@
1;;; ido.el --- interactively do things with buffers and files. 1;;; ido.el --- interactively do things with buffers and files.
2 2
3;; Copyright (C) 1996-2003 Free Software Foundation, Inc. 3;; Copyright (C) 1996-2004 Free Software Foundation, Inc.
4 4
5;; Author: Kim F. Storm <storm@cua.dk> 5;; Author: Kim F. Storm <storm@cua.dk>
6;; Based on: iswitchb by Stephen Eglen <stephen@cns.ed.ac.uk> 6;; Based on: iswitchb by Stephen Eglen <stephen@cns.ed.ac.uk>
@@ -30,8 +30,9 @@
30;; for ido-switch-buffer and found the inspiration for ido-find-file. 30;; for ido-switch-buffer and found the inspiration for ido-find-file.
31;; The ido package would never have existed without his work. 31;; The ido package would never have existed without his work.
32 32
33;; Also thanks to Klaus Berndl, Rohit Namjoshi, Robert Fenk, Alex Schroeder, 33;; Also thanks to Klaus Berndl, Rohit Namjoshi, Robert Fenk, Alex
34;; Bill Benedetto, and Stephen Eglen for bug fixes and improvements. 34;; Schroeder, Bill Benedetto, Stephen Eglen, and many others for bug
35;; fixes and improvements.
35 36
36;;; History 37;;; History
37 38
@@ -55,7 +56,7 @@
55;; so I invented a common "ido-" namespace for the merged packages. 56;; so I invented a common "ido-" namespace for the merged packages.
56;; 57;;
57;; This version is based on ido.el version 1.57 released on 58;; This version is based on ido.el version 1.57 released on
58;; gnu.emacs.sources adapted for emacs 21.4 to use command remapping 59;; gnu.emacs.sources adapted for emacs 21.5 to use command remapping
59;; and optionally hooking the read-buffer and read-file-name functions. 60;; and optionally hooking the read-buffer and read-file-name functions.
60;; 61;;
61;; Prefix matching was added by Klaus Berndl <klaus.berndl@sdm.de> based on 62;; Prefix matching was added by Klaus Berndl <klaus.berndl@sdm.de> based on
@@ -1667,8 +1668,7 @@ If INITIAL is non-nil, it specifies the initial input string."
1667 ((memq ido-exit '(edit chdir)) 1668 ((memq ido-exit '(edit chdir))
1668 (cond 1669 (cond
1669 ((memq ido-cur-item '(file dir)) 1670 ((memq ido-cur-item '(file dir))
1670 (let* ((process-environment (cons "HOME=/" process-environment)) ;; cheat read-file-name 1671 (let* ((read-file-name-function nil)
1671 (read-file-name-function nil)
1672 (edit (eq ido-exit 'edit)) 1672 (edit (eq ido-exit 'edit))
1673 (d ido-current-directory) 1673 (d ido-current-directory)
1674 (f ido-text-init) 1674 (f ido-text-init)
@@ -1676,7 +1676,9 @@ If INITIAL is non-nil, it specifies the initial input string."
1676 (setq ido-text-init "") 1676 (setq ido-text-init "")
1677 (while new 1677 (while new
1678 (setq new (if edit 1678 (setq new (if edit
1679 (read-file-name (concat prompt "[EDIT] ") d (concat d f) nil f) 1679 (read-file-name (concat prompt "[EDIT] ")
1680 (expand-file-name d)
1681 (concat d f) nil f)
1680 f) 1682 f)
1681 d (or (file-name-directory new) "/") 1683 d (or (file-name-directory new) "/")
1682 f (file-name-nondirectory new) 1684 f (file-name-nondirectory new)
@@ -3807,15 +3809,19 @@ For details of keybindings, do `\\[describe-function] ido-find-file'."
3807 3809
3808;;; Helper functions for other programs 3810;;; Helper functions for other programs
3809 3811
3812(put 'dired-do-rename 'ido 'ignore)
3813
3810;;;###autoload 3814;;;###autoload
3811(defun ido-read-file-name (prompt &optional dir default-filename mustmatch initial predicate) 3815(defun ido-read-file-name (prompt &optional dir default-filename mustmatch initial predicate)
3812 "Read file name, prompting with PROMPT and completing in directory DIR. 3816 "Read file name, prompting with PROMPT and completing in directory DIR.
3813See `read-file-name' for additional parameters." 3817See `read-file-name' for additional parameters."
3814 (cond 3818 (cond
3815 ((or (eq predicate 'file-directory-p) 3819 ((or (eq predicate 'file-directory-p)
3820 (eq (get this-command 'ido) 'dir)
3816 (memq this-command ido-read-file-name-as-directory-commands)) 3821 (memq this-command ido-read-file-name-as-directory-commands))
3817 (ido-read-directory-name prompt dir default-filename mustmatch initial)) 3822 (ido-read-directory-name prompt dir default-filename mustmatch initial))
3818 ((and (not (memq this-command ido-read-file-name-non-ido)) 3823 ((and (not (eq (get this-command 'ido) 'ignore))
3824 (not (memq this-command ido-read-file-name-non-ido))
3819 (or (null predicate) (eq predicate 'file-exists-p))) 3825 (or (null predicate) (eq predicate 'file-exists-p)))
3820 (let* (filename 3826 (let* (filename
3821 ido-saved-vc-hb 3827 ido-saved-vc-hb
diff --git a/lisp/ielm.el b/lisp/ielm.el
index 53e3d83cdaa..944e2453cb9 100644
--- a/lisp/ielm.el
+++ b/lisp/ielm.el
@@ -51,9 +51,30 @@
51 51
52(defcustom ielm-prompt-read-only t 52(defcustom ielm-prompt-read-only t
53 "If non-nil, the IELM prompt is read only. 53 "If non-nil, the IELM prompt is read only.
54The read only region includes the newline before the prompt.
54Setting this variable does not affect existing IELM runs. 55Setting this variable does not affect existing IELM runs.
55This works by setting the buffer-local value of `comint-prompt-read-only'. 56This works by setting the buffer-local value of `comint-prompt-read-only'.
56Setting that value directly affects new prompts in the current buffer." 57Setting that value directly affects new prompts in the current buffer.
58
59If this option is enabled, then the safe way to temporarily
60override the read-only-ness of ielm prompts is to call
61`comint-kill-whole-line' or `comint-kill-region' with no
62narrowing in effect. This way you will be certain that none of
63the remaining prompts will be accidentally messed up. You may
64wish to put something like the following in your `.emacs' file:
65
66\(add-hook 'ielm-mode-hook
67 '(lambda ()
68 (define-key ielm-map \"\C-w\" 'comint-kill-region)
69 (define-key ielm-map [C-S-backspace]
70 'comint-kill-whole-line)))
71
72If you set `comint-prompt-read-only' to t, you might wish to use
73`comint-mode-hook' and `comint-mode-map' instead of
74`ielm-mode-hook' and `ielm-map'. That will affect all comint
75buffers, including ielm buffers. If you sometimes use ielm on
76text-only terminals or with `emacs -nw', you might wish to use
77another binding for `comint-kill-whole-line'."
57 :type 'boolean 78 :type 'boolean
58 :group 'ielm 79 :group 'ielm
59 :version "21.4") 80 :version "21.4")
diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el
index f3744a38337..7bada72310c 100644
--- a/lisp/iswitchb.el
+++ b/lisp/iswitchb.el
@@ -464,7 +464,7 @@ interfere with other minibuffer usage.")
464 (substitute-key-definition 'display-buffer ; C-x 4 C-o 464 (substitute-key-definition 'display-buffer ; C-x 4 C-o
465 'iswitchb-display-buffer map global-map) 465 'iswitchb-display-buffer map global-map)
466 map) 466 map)
467 "Global keymap for `iswtichb-mode'.") 467 "Global keymap for `iswitchb-mode'.")
468 468
469(defvar iswitchb-history nil 469(defvar iswitchb-history nil
470 "History of buffers selected using `iswitchb-buffer'.") 470 "History of buffers selected using `iswitchb-buffer'.")
@@ -571,7 +571,6 @@ in a separate window.
571 (iswitchb-possible-new-buffer buf))) 571 (iswitchb-possible-new-buffer buf)))
572 )))) 572 ))))
573 573
574;;;###autoload
575(defun iswitchb-read-buffer (prompt &optional default require-match) 574(defun iswitchb-read-buffer (prompt &optional default require-match)
576 "Replacement for the built-in `read-buffer'. 575 "Replacement for the built-in `read-buffer'.
577Return the name of a buffer selected. 576Return the name of a buffer selected.
@@ -1073,7 +1072,6 @@ If BUFFER is visible in the current frame, return nil."
1073 (get-buffer-window buffer 0) ; better than 'visible 1072 (get-buffer-window buffer 0) ; better than 'visible
1074 ))) 1073 )))
1075 1074
1076;;;###autoload
1077(defun iswitchb-default-keybindings () 1075(defun iswitchb-default-keybindings ()
1078 "Set up default keybindings for `iswitchb-buffer'. 1076 "Set up default keybindings for `iswitchb-buffer'.
1079Call this function to override the normal bindings. This function also 1077Call this function to override the normal bindings. This function also
@@ -1087,7 +1085,6 @@ Obsolescent. Use `iswitchb-mode'."
1087 (global-set-key "\C-x4\C-o" 'iswitchb-display-buffer) 1085 (global-set-key "\C-x4\C-o" 'iswitchb-display-buffer)
1088 (global-set-key "\C-x5b" 'iswitchb-buffer-other-frame)) 1086 (global-set-key "\C-x5b" 'iswitchb-buffer-other-frame))
1089 1087
1090;;;###autoload
1091(defun iswitchb-buffer () 1088(defun iswitchb-buffer ()
1092 "Switch to another buffer. 1089 "Switch to another buffer.
1093 1090
@@ -1100,7 +1097,6 @@ For details of keybindings, do `\\[describe-function] iswitchb'."
1100 (setq iswitchb-method iswitchb-default-method) 1097 (setq iswitchb-method iswitchb-default-method)
1101 (iswitchb)) 1098 (iswitchb))
1102 1099
1103;;;###autoload
1104(defun iswitchb-buffer-other-window () 1100(defun iswitchb-buffer-other-window ()
1105 "Switch to another buffer and show it in another window. 1101 "Switch to another buffer and show it in another window.
1106The buffer name is selected interactively by typing a substring. 1102The buffer name is selected interactively by typing a substring.
@@ -1109,7 +1105,6 @@ For details of keybindings, do `\\[describe-function] iswitchb'."
1109 (setq iswitchb-method 'otherwindow) 1105 (setq iswitchb-method 'otherwindow)
1110 (iswitchb)) 1106 (iswitchb))
1111 1107
1112;;;###autoload
1113(defun iswitchb-display-buffer () 1108(defun iswitchb-display-buffer ()
1114 "Display a buffer in another window but don't select it. 1109 "Display a buffer in another window but don't select it.
1115The buffer name is selected interactively by typing a substring. 1110The buffer name is selected interactively by typing a substring.
@@ -1118,7 +1113,6 @@ For details of keybindings, do `\\[describe-function] iswitchb'."
1118 (setq iswitchb-method 'display) 1113 (setq iswitchb-method 'display)
1119 (iswitchb)) 1114 (iswitchb))
1120 1115
1121;;;###autoload
1122(defun iswitchb-buffer-other-frame () 1116(defun iswitchb-buffer-other-frame ()
1123 "Switch to another buffer and show it in another frame. 1117 "Switch to another buffer and show it in another frame.
1124The buffer name is selected interactively by typing a substring. 1118The buffer name is selected interactively by typing a substring.
diff --git a/lisp/makefile.nt b/lisp/makefile.nt
deleted file mode 100644
index 069ef96ac98..00000000000
--- a/lisp/makefile.nt
+++ /dev/null
@@ -1,284 +0,0 @@
1# Hacked up Nmake makefile for GNU Emacs
2# Geoff Voelker (voelker@cs.washington.edu)
3# Copyright (c) 1994 Free Software Foundation, Inc.
4#
5# This file is part of GNU Emacs.
6#
7# GNU Emacs is free software; you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation; either version 2, or (at your option)
10# any later version.
11#
12# GNU Emacs is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with GNU Emacs; see the file COPYING. If not, write to the
19# Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20# Boston, MA 02111-1307, USA.
21#
22
23!include ..\nt\makefile.def
24
25all:
26
27#lisp=$(MAKEDIR:\=/)
28lisp=.
29
30# You can specify a different executable on the make command line,
31# e.g. "make EMACS=../src/emacs ...".
32
33EMACS = ..\bin\emacs.exe
34
35# Command line flags for Emacs. This must include --multibyte,
36# otherwise some files will not compile.
37
38EMACSOPT = -batch --no-init-file --no-site-file --multibyte
39
40lisptagsfiles1 = $(lisp)/*.el
41lisptagsfiles2 = $(lisp)/*/*.el
42ETAGS = ..\lib-src\$(BLD)\etags
43
44# Files which should not be compiled.
45# - emacs-lisp/cl-specs.el: only contains `def-edebug-spec's so there's
46# no point compiling it, although it doesn't hurt.
47
48DONTCOMPILE = \
49 $(lisp)/cus-load.el \
50 $(lisp)/cus-start.el \
51 $(lisp)/emacs-lisp/cl-specs.el \
52 $(lisp)/eshell/esh-maint.el \
53 $(lisp)/eshell/esh-groups.el \
54 $(lisp)/finder-inf.el \
55 $(lisp)/forms-d2.el \
56 $(lisp)/forms-pass.el \
57 $(lisp)/generic-x.el \
58 $(lisp)/international/latin-1.el \
59 $(lisp)/international/latin-2.el \
60 $(lisp)/international/latin-3.el \
61 $(lisp)/international/latin-4.el \
62 $(lisp)/international/latin-5.el \
63 $(lisp)/international/latin-8.el \
64 $(lisp)/international/latin-9.el \
65 $(lisp)/international/mule-conf.el \
66 $(lisp)/loaddefs.el \
67 $(lisp)/loadup.el \
68 $(lisp)/mail/blessmail.el \
69 $(lisp)/patcomp.el \
70 $(lisp)/paths.el \
71 $(lisp)/play/bruce.el \
72 $(lisp)/subdirs.el \
73 $(lisp)/term/internal.el \
74 $(lisp)/term/AT386.el \
75 $(lisp)/term/apollo.el \
76 $(lisp)/term/bobcat.el \
77 $(lisp)/term/iris-ansi.el \
78 $(lisp)/term/keyswap.el \
79 $(lisp)/term/linux.el \
80 $(lisp)/term/lk201.el \
81 $(lisp)/term/news.el \
82 $(lisp)/term/vt102.el \
83 $(lisp)/term/vt125.el \
84 $(lisp)/term/vt200.el \
85 $(lisp)/term/vt201.el \
86 $(lisp)/term/vt220.el \
87 $(lisp)/term/vt240.el \
88 $(lisp)/term/vt300.el \
89 $(lisp)/term/vt320.el \
90 $(lisp)/term/vt400.el \
91 $(lisp)/term/vt420.el \
92 $(lisp)/term/wyse50.el \
93 $(lisp)/term/xterm.el \
94 $(lisp)/version.el
95
96# Files to compile before others during a bootstrap. This is done
97# to speed up the bootstrap process.
98
99COMPILE_FIRST = \
100 $(lisp)/emacs-lisp/byte-opt.el \
101 $(lisp)/emacs-lisp/bytecomp.el \
102 $(lisp)/subr.el
103
104# The actual Emacs command run in the targets below.
105
106emacs = $(EMACS) $(EMACSOPT)
107
108# Common command to find subdirectories
109
110# setwins=subdirs=`find $$wd -type d -print`; \
111# for file in $$subdirs; do \
112# case $$file in */Old | */RCS | */CVS | */CVS/* | */=* ) ;; \
113# *) wins="$$wins $$file" ;; \
114# esac; \
115# done
116
117# Have to define the list of subdirs manually
118WINS=\
119 calendar \
120 emacs-lisp \
121 emulation \
122 eshell \
123 gnus \
124 international \
125 language \
126 mail \
127 mh-e \
128 net \
129 play \
130 progmodes \
131 term \
132 textmodes
133
134doit:
135
136cus-load.el:
137 touch $@
138custom-deps: cus-load.el doit
139 @echo Directories: $(WINS)
140 $(emacs) -l cus-dep --eval "(setq find-file-hooks nil)" -f custom-make-dependencies $(lisp) $(WINS)
141
142finder-inf.el:
143 echo (provide 'finder-inf)>> $@
144
145finder-data: finder-inf.el doit
146 @echo Directories: $(WINS)
147 $(emacs) -l finder -f finder-compile-keywords-make-dist $(lisp) $(WINS)
148
149loaddefs.el:
150 echo ;;; loaddefs.el --- automatically extracted autoloads> $@
151 echo ;;; Code:>> $@
152 echo >> $@
153 echo ;;; Local Variables:>> $@
154 echo ;;; version-control: never>> $@
155 echo ;;; no-byte-compile: t>> $@
156 echo ;;; no-update-autoloads: t>> $@
157 echo ;;; End:>> $@
158 echo ;;; loaddefs.el ends here>> $@
159
160autoloads: loaddefs.el doit
161 @echo Directories: $(WINS)
162 $(emacs) -l autoload --eval "(setq find-file-hooks nil generated-autoload-file \"$(lisp)/loaddefs.el\")" -f batch-update-autoloads $(lisp) $(WINS)
163
164subdirs.el:
165 $(MAKE) $(MFLAGS) -f makefile.nt update-subdirs
166update-subdirs: doit
167 @set QWINS=
168 @for %d in ($(WINS)) do if not (%d)==(term) set QWINS=%QWINS% "%d"
169 echo ;; In load-path, after this directory should come> subdirs.el
170 echo ;; certain of its subdirectories. Here we specify them.>> subdirs.el
171 echo (normal-top-level-add-to-load-path '(%QWINS%))>> subdirs.el
172
173updates: update-subdirs autoloads finder-data custom-deps
174
175TAGS: $(lisptagsfiles1) $(lisptagsfiles2)
176 $(ETAGS) $(lisptagsfiles1) $(lisptagsfiles2)
177
178TAGS-LISP: $(lispsource)$(lisptagsfiles1) $(lispsource)$(lisptagsfiles2)
179 $(ETAGS) -o TAGS-LISP $(lispsource)$(lisptagsfiles1) $(lispsource)$(lisptagsfiles2)
180
181.SUFFIXES: .elc .el
182
183.el.elc:
184 -$(emacs) -f batch-byte-compile $<
185
186$(DONTCOMPILE:.el=.elc):
187 -$(DEL) $@
188
189# Compile all Lisp files, except those from DONTCOMPILE. This
190# compiles files unconditionally. All .elc files are made writable
191# before compilation in case we checked out read-only (CVS option -r).
192# Files MUST be compiled one by one. If we compile several files in a
193# row we can't make sure that the compilation environment is clean.
194# We also set the load-path of the Emacs used for compilation to the
195# current directory and its subdirectories, to make sure require's and
196# load's in the files being compiled find the right files.
197
198compile-files: subdirs.el doit
199# -for %f in ($(lisp) $(WINS)) do for %g in (%f\*.elc) do @attrib -r %g
200 for %f in ($(COMPILE_FIRST)) do $(emacs) -f batch-byte-compile %f
201 for %f in ($(lisp) $(WINS)) do for %g in (%f/*.el) do $(emacs) -f batch-byte-compile %f/%g
202
203# Backup compiled Lisp files in elc.tar.gz. If that file already
204# exists, make a backup of it.
205
206backup-compiled-files:
207 -mv $(lisp)/elc.tar.gz $(lisp)/elc.tar.gz~
208 -tar czf $(lisp)/elc.tar.gz $(lisp)/*.elc $(lisp)/*/*.elc
209
210# Compile Lisp files, but save old compiled files first.
211
212compile: backup-compiled-files compile-files
213
214# Recompile all Lisp files which are newer than their .elc files.
215# Note that this doesn't create .elc files. It only recompiles if an
216# .elc is present.
217
218recompile: doit
219 $(emacs) -f batch-byte-recompile-directory .
220
221# Prepare a bootstrap in the lisp subdirectory. Build loaddefs.el,
222# because it's not sure it's up-to-date, and if it's not, that might
223# lead to errors during the bootstrap because something fails to
224# autoload as expected. Remove compiled Lisp files so that
225# bootstrap-emacs will be built from sources only.
226
227bootstrap-clean:
228 if exist $(EMACS) $(MAKE) $(MFLAGS) -f makefile.nt autoloads
229 -for %f in ($(lisp) $(WINS)) do for %g in (%f\*.elc) do @$(DEL) %g
230
231# Generate/update files for the bootstrap process.
232
233bootstrap: autoloads compile-files custom-deps
234
235#
236# Assuming INSTALL_DIR is defined, copy the elisp files to it
237# Windows 95 makes this harder than it should be.
238#
239install:
240 - mkdir $(INSTALL_DIR)\lisp
241 - $(DEL) .\same-dir.tst
242 - $(DEL) $(INSTALL_DIR)\lisp\same-dir.tst
243 echo SameDirTest > $(INSTALL_DIR)\lisp\same-dir.tst
244!ifdef COPY_LISP_SOURCE
245 if not exist .\same-dir.tst $(CP_DIR) . $(INSTALL_DIR)\lisp
246!else
247 if not exist .\same-dir.tst $(CP_DIR) *.elc $(INSTALL_DIR)\lisp
248 if not exist .\same-dir.tst $(CP) cus-load.el $(INSTALL_DIR)\lisp
249 if not exist .\same-dir.tst $(CP) cus-start.el $(INSTALL_DIR)\lisp
250 if not exist .\same-dir.tst $(CP) emacs-lisp\cl-specs.el $(INSTALL_DIR)\lisp\emacs-lisp
251 if not exist .\same-dir.tst $(CP) eshell\esh-maint.el $(INSTALL_DIR)\lisp\eshell
252 if not exist .\same-dir.tst $(CP) eshell\esh-groups.el $(INSTALL_DIR)\lisp\eshell
253 if not exist .\same-dir.tst $(CP) finder-inf.el $(INSTALL_DIR)\lisp
254 if not exist .\same-dir.tst $(CP) forms*.el $(INSTALL_DIR)\lisp
255 if not exist .\same-dir.tst $(CP) generic-x.el $(INSTALL_DIR)\lisp
256 if not exist .\same-dir.tst $(CP) patcomp.el $(INSTALL_DIR)\lisp
257 if not exist .\same-dir.tst $(CP) subdirs.el $(INSTALL_DIR)\lisp
258 if not exist .\same-dir.tst $(CP) version.el $(INSTALL_DIR)\lisp
259 if not exist .\same-dir.tst $(CP) mail\blessmail.el $(INSTALL_DIR)\lisp\mail
260 if not exist .\same-dir.tst $(CP) play\bruce.el $(INSTALL_DIR)\lisp\play
261 if not exist .\same-dir.tst $(CP) international\latin-*.el $(INSTALL_DIR)\lisp\international
262 if not exist .\same-dir.tst $(CP) international\mule-conf.el $(INSTALL_DIR)\lisp\international
263 - $(DEL) $(INSTALL_DIR)\lisp\same-dir.tst
264!endif
265
266#
267# Maintenance
268#
269clean:
270 - $(DEL) *~ term\*~
271 - $(DEL) *.orig *.rej *.crlf
272 - $(DEL) emacs-lisp\*.orig emacs-lisp\*.rej emacs-lisp\*.crlf
273 - $(DEL) emulation\*.orig emulation\*.rej emulation\*.crlf
274 - $(DEL) gnus\*.orig gnus\*.rej gnus\*.crlf
275 - $(DEL) international\*.orig international\*.rej international\*.crlf
276 - $(DEL) language\*.orig language\*.rej language\*.crlf
277 - $(DEL) mail\*.orig mail\*.rej mail\*.crlf
278 - $(DEL) play\*.orig play\*.rej play\*.crlf
279 - $(DEL) progmodes\*.orig progmodes\*.rej progmodes\*.crlf
280 - $(DEL) term\*.orig term\*.rej term\*.crlf
281 - $(DEL) textmodes\*.orig textmodes\*.rej textmodes\*.crlf
282 - $(DEL_TREE) deleted
283
284# arch-tag: 01ddeb44-fb4c-4366-8478-4a6c21a68fb3
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
index 4c6f88813c0..ec381ad8a15 100644
--- a/lisp/progmodes/compile.el
+++ b/lisp/progmodes/compile.el
@@ -944,6 +944,7 @@ Returns the compilation buffer created."
944 ;; Fake modeline display as if `start-process' were run. 944 ;; Fake modeline display as if `start-process' were run.
945 (setq mode-line-process ":run") 945 (setq mode-line-process ":run")
946 (force-mode-line-update) 946 (force-mode-line-update)
947 (sit-for 0) ; Force redisplay
947 (let ((status (call-process shell-file-name nil outbuf nil "-c" 948 (let ((status (call-process shell-file-name nil outbuf nil "-c"
948 command))) 949 command)))
949 (cond ((numberp status) 950 (cond ((numberp status)
@@ -958,6 +959,10 @@ exited abnormally with code %d\n"
958 (concat status "\n"))) 959 (concat status "\n")))
959 (t 960 (t
960 (compilation-handle-exit 'bizarre status status)))) 961 (compilation-handle-exit 'bizarre status status))))
962 ;; Without async subprocesses, the buffer is not yet
963 ;; fontified, so fontify it now.
964 (let ((font-lock-verbose nil)) ; shut up font-lock messages
965 (font-lock-fontify-buffer))
961 (message "Executing `%s'...done" command))) 966 (message "Executing `%s'...done" command)))
962 (if (buffer-local-value 'compilation-scroll-output outbuf) 967 (if (buffer-local-value 'compilation-scroll-output outbuf)
963 (save-selected-window 968 (save-selected-window
@@ -1095,10 +1100,6 @@ Runs `compilation-mode-hook' with `run-hooks' (which see)."
1095 (set (make-local-variable 'page-delimiter) 1100 (set (make-local-variable 'page-delimiter)
1096 compilation-page-delimiter) 1101 compilation-page-delimiter)
1097 (compilation-setup) 1102 (compilation-setup)
1098 ;; note that compilation-next-error-function is for interfacing
1099 ;; with the next-error function in simple.el, and it's only
1100 ;; coincidentally named similarly to compilation-next-error
1101 (setq next-error-function 'compilation-next-error-function)
1102 (run-mode-hooks 'compilation-mode-hook)) 1103 (run-mode-hooks 'compilation-mode-hook))
1103 1104
1104(defmacro define-compilation-mode (mode name doc &rest body) 1105(defmacro define-compilation-mode (mode name doc &rest body)
@@ -1150,6 +1151,10 @@ variable exists."
1150 "Marker to the location from where the next error will be found. 1151 "Marker to the location from where the next error will be found.
1151The global commands next/previous/first-error/goto-error use this.") 1152The global commands next/previous/first-error/goto-error use this.")
1152 1153
1154(defvar compilation-messages-start nil
1155 "Buffer position of the beginning of the compilation messages.
1156If nil, use the beginning of buffer.")
1157
1153;; A function name can't be a hook, must be something with a value. 1158;; A function name can't be a hook, must be something with a value.
1154(defconst compilation-turn-on-font-lock 'turn-on-font-lock) 1159(defconst compilation-turn-on-font-lock 'turn-on-font-lock)
1155 1160
@@ -1158,8 +1163,13 @@ The global commands next/previous/first-error/goto-error use this.")
1158Optional argument MINOR indicates this is called from 1163Optional argument MINOR indicates this is called from
1159`compilation-minor-mode'." 1164`compilation-minor-mode'."
1160 (make-local-variable 'compilation-current-error) 1165 (make-local-variable 'compilation-current-error)
1166 (make-local-variable 'compilation-messages-start)
1161 (make-local-variable 'compilation-error-screen-columns) 1167 (make-local-variable 'compilation-error-screen-columns)
1162 (make-local-variable 'overlay-arrow-position) 1168 (make-local-variable 'overlay-arrow-position)
1169 ;; Note that compilation-next-error-function is for interfacing
1170 ;; with the next-error function in simple.el, and it's only
1171 ;; coincidentally named similarly to compilation-next-error.
1172 (setq next-error-function 'compilation-next-error-function)
1163 (set (make-local-variable 'font-lock-extra-managed-props) 1173 (set (make-local-variable 'font-lock-extra-managed-props)
1164 '(directory message help-echo mouse-face debug)) 1174 '(directory message help-echo mouse-face debug))
1165 (set (make-local-variable 'compilation-locs) 1175 (set (make-local-variable 'compilation-locs)
@@ -1404,16 +1414,16 @@ Use this command in a compilation log buffer. Sets the mark at point there."
1404 (let* ((columns compilation-error-screen-columns) ; buffer's local value 1414 (let* ((columns compilation-error-screen-columns) ; buffer's local value
1405 (last 1) 1415 (last 1)
1406 (loc (compilation-next-error (or n 1) nil 1416 (loc (compilation-next-error (or n 1) nil
1407 (or compilation-current-error (point-min)))) 1417 (or compilation-current-error
1418 compilation-messages-start
1419 (point-min))))
1408 (end-loc (nth 2 loc)) 1420 (end-loc (nth 2 loc))
1409 (marker (point-marker))) 1421 (marker (point-marker)))
1410 (setq compilation-current-error (point-marker) 1422 (setq compilation-current-error (point-marker)
1411 overlay-arrow-position 1423 overlay-arrow-position
1412 (if (bolp) 1424 (if (bolp)
1413 compilation-current-error 1425 compilation-current-error
1414 (save-excursion 1426 (copy-marker (line-beginning-position)))
1415 (beginning-of-line)
1416 (point-marker)))
1417 loc (car loc)) 1427 loc (car loc))
1418 ;; If loc contains no marker, no error in that file has been visited. If 1428 ;; If loc contains no marker, no error in that file has been visited. If
1419 ;; the marker is invalid the buffer has been killed. So, recalculate all 1429 ;; the marker is invalid the buffer has been killed. So, recalculate all
@@ -1447,6 +1457,10 @@ Use this command in a compilation log buffer. Sets the mark at point there."
1447 (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc)) 1457 (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc))
1448 (setcdr (nthcdr 3 loc) t))) ; Set this one as visited. 1458 (setcdr (nthcdr 3 loc) t))) ; Set this one as visited.
1449 1459
1460(defvar compilation-gcpro nil
1461 "Internal variable used to keep some values from being GC'd.")
1462(make-variable-buffer-local 'compilation-gcpro)
1463
1450(defun compilation-fake-loc (marker file &optional line col) 1464(defun compilation-fake-loc (marker file &optional line col)
1451 "Preassociate MARKER with FILE. 1465 "Preassociate MARKER with FILE.
1452FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME). 1466FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME).
@@ -1466,6 +1480,11 @@ call this several times, once each for the last line of one
1466region and the first line of the next region." 1480region and the first line of the next region."
1467 (or (consp file) (setq file (list file))) 1481 (or (consp file) (setq file (list file)))
1468 (setq file (compilation-get-file-structure file)) 1482 (setq file (compilation-get-file-structure file))
1483 ;; Between the current call to compilation-fake-loc and the first occurrence
1484 ;; of an error message referring to `file', the data is only kept is the
1485 ;; weak hash-table compilation-locs, so we need to prevent this entry
1486 ;; in compilation-locs from being GC'd away. --Stef
1487 (push file compilation-gcpro)
1469 (let ((loc (compilation-assq (or line 1) (cdr file)))) 1488 (let ((loc (compilation-assq (or line 1) (cdr file))))
1470 (setq loc (compilation-assq col loc)) 1489 (setq loc (compilation-assq col loc))
1471 (if (cdr loc) 1490 (if (cdr loc)
@@ -1715,10 +1734,12 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."
1715 (goto-char limit) 1734 (goto-char limit)
1716 nil) 1735 nil)
1717 1736
1737;; Beware: this is not only compatiblity code. New code stil uses it. --Stef
1718(defun compilation-forget-errors () 1738(defun compilation-forget-errors ()
1719 ;; In case we hit the same file/line specs, we want to recompute a new 1739 ;; In case we hit the same file/line specs, we want to recompute a new
1720 ;; marker for them, so flush our cache. 1740 ;; marker for them, so flush our cache.
1721 (setq compilation-locs (make-hash-table :test 'equal :weakness 'value)) 1741 (setq compilation-locs (make-hash-table :test 'equal :weakness 'value))
1742 (setq compilation-gcpro nil)
1722 ;; FIXME: the old code reset the directory-stack, so maybe we should 1743 ;; FIXME: the old code reset the directory-stack, so maybe we should
1723 ;; put a `directory change' marker of some sort, but where? -stef 1744 ;; put a `directory change' marker of some sort, but where? -stef
1724 ;; 1745 ;;
@@ -1730,9 +1751,19 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)."
1730 ;; something equivalent to point-max. So we speculatively move 1751 ;; something equivalent to point-max. So we speculatively move
1731 ;; compilation-current-error to point-max (since the external package 1752 ;; compilation-current-error to point-max (since the external package
1732 ;; won't know that it should do it). --stef 1753 ;; won't know that it should do it). --stef
1733 (setq compilation-current-error (point-max))) 1754 (setq compilation-current-error nil)
1755 (let* ((proc (get-buffer-process (current-buffer)))
1756 (mark (if proc (process-mark proc)))
1757 (pos (or mark (point-max))))
1758 (setq compilation-messages-start
1759 ;; In the future, ignore the text already present in the buffer.
1760 ;; Since many process filter functions insert before markers,
1761 ;; we need to put ours just before the insertion point rather
1762 ;; than at the insertion point. If that's not possible, then
1763 ;; don't use a marker. --Stef
1764 (if (> pos (point-min)) (copy-marker (1- pos)) pos))))
1734 1765
1735(provide 'compile) 1766(provide 'compile)
1736 1767
1737;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c 1768;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
1738;;; compile.el ends here 1769;;; compile.el ends here
diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el
index 2e836fb82b2..fc3196cdb4f 100644
--- a/lisp/progmodes/gdb-ui.el
+++ b/lisp/progmodes/gdb-ui.el
@@ -217,9 +217,10 @@ speedbar."
217 (gdb-enqueue-input 217 (gdb-enqueue-input
218 (list (concat "server interpreter mi \"-var-create - * " expr "\"\n") 218 (list (concat "server interpreter mi \"-var-create - * " expr "\"\n")
219 `(lambda () (gdb-var-create-handler ,expr)))))) 219 `(lambda () (gdb-var-create-handler ,expr))))))
220 (select-window (get-buffer-window gud-comint-buffer))) 220 (select-window (get-buffer-window gud-comint-buffer 'visible)))
221 221
222(defun gdb-goto-info () 222(defun gdb-goto-info ()
223 "Go to Emacs info node: GDB Graphical Interface."
223 (interactive) 224 (interactive)
224 (select-frame (make-frame)) 225 (select-frame (make-frame))
225 (require 'info) 226 (require 'info)
@@ -1117,7 +1118,7 @@ static char *magick[] = {
1117 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) 1118 (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
1118 1119
1119(defun gdb-mouse-toggle-breakpoint (event) 1120(defun gdb-mouse-toggle-breakpoint (event)
1120 "Toggle breakpoint with mouse click in left margin." 1121 "Toggle breakpoint in left fringe/margin with mouse click"
1121 (interactive "e") 1122 (interactive "e")
1122 (mouse-minibuffer-check event) 1123 (mouse-minibuffer-check event)
1123 (let ((posn (event-end event))) 1124 (let ((posn (event-end event)))
@@ -1137,6 +1138,7 @@ static char *magick[] = {
1137 (concat "*breakpoints of " (gdb-get-target-string) "*"))) 1138 (concat "*breakpoints of " (gdb-get-target-string) "*")))
1138 1139
1139(defun gdb-display-breakpoints-buffer () 1140(defun gdb-display-breakpoints-buffer ()
1141 "Display status of user-settable breakpoints."
1140 (interactive) 1142 (interactive)
1141 (gdb-display-buffer 1143 (gdb-display-buffer
1142 (gdb-get-create-buffer 'gdb-breakpoints-buffer))) 1144 (gdb-get-create-buffer 'gdb-breakpoints-buffer)))
@@ -1149,6 +1151,7 @@ static char *magick[] = {
1149 (minibuffer . nil))) 1151 (minibuffer . nil)))
1150 1152
1151(defun gdb-frame-breakpoints-buffer () 1153(defun gdb-frame-breakpoints-buffer ()
1154 "Display status of user-settable breakpoints in a new frame."
1152 (interactive) 1155 (interactive)
1153 (select-frame (make-frame gdb-frame-parameters)) 1156 (select-frame (make-frame gdb-frame-parameters))
1154 (switch-to-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer)) 1157 (switch-to-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer))
@@ -1205,8 +1208,7 @@ static char *magick[] = {
1205 (list (concat "server delete " (match-string 1) "\n") 'ignore)))) 1208 (list (concat "server delete " (match-string 1) "\n") 'ignore))))
1206 1209
1207(defun gdb-goto-breakpoint () 1210(defun gdb-goto-breakpoint ()
1208 "Display the file in the source buffer at the breakpoint specified on the 1211 "Display the breakpoint location specified at current line."
1209current line."
1210 (interactive) 1212 (interactive)
1211 (save-excursion 1213 (save-excursion
1212 (beginning-of-line 1) 1214 (beginning-of-line 1)
@@ -1216,14 +1218,16 @@ current line."
1216 (let ((line (match-string 2)) 1218 (let ((line (match-string 2))
1217 (file (match-string 1))) 1219 (file (match-string 1)))
1218 (save-selected-window 1220 (save-selected-window
1219 (gdb-display-buffer (find-file-noselect 1221 (let* ((buf (find-file-noselect (if (file-exists-p file)
1220 (if (file-exists-p file) 1222 file
1221 file 1223 (expand-file-name file gdb-cdir))))
1222 (expand-file-name file gdb-cdir)))) 1224 (window (gdb-display-buffer buf)))
1223 (goto-line (string-to-number line)))))) 1225 (with-current-buffer buf
1226 (goto-line (string-to-number line))
1227 (set-window-point window (point))))))))
1224 1228
1225(defun gdb-mouse-goto-breakpoint (event) 1229(defun gdb-mouse-goto-breakpoint (event)
1226 "Display the file in the source buffer at the selected breakpoint." 1230 "Display the breakpoint location that you click on."
1227 (interactive "e") 1231 (interactive "e")
1228 (mouse-set-point event) 1232 (mouse-set-point event)
1229 (gdb-goto-breakpoint)) 1233 (gdb-goto-breakpoint))
@@ -1266,11 +1270,13 @@ current line."
1266 (concat "*stack frames of " (gdb-get-target-string) "*"))) 1270 (concat "*stack frames of " (gdb-get-target-string) "*")))
1267 1271
1268(defun gdb-display-stack-buffer () 1272(defun gdb-display-stack-buffer ()
1273 "Display backtrace of current stack."
1269 (interactive) 1274 (interactive)
1270 (gdb-display-buffer 1275 (gdb-display-buffer
1271 (gdb-get-create-buffer 'gdb-stack-buffer))) 1276 (gdb-get-create-buffer 'gdb-stack-buffer)))
1272 1277
1273(defun gdb-frame-stack-buffer () 1278(defun gdb-frame-stack-buffer ()
1279 "Display backtrace of current stack in a new frame."
1274 (interactive) 1280 (interactive)
1275 (select-frame (make-frame gdb-frame-parameters)) 1281 (select-frame (make-frame gdb-frame-parameters))
1276 (switch-to-buffer (gdb-get-create-buffer 'gdb-stack-buffer)) 1282 (switch-to-buffer (gdb-get-create-buffer 'gdb-stack-buffer))
@@ -1301,16 +1307,14 @@ current line."
1301 n))) 1307 n)))
1302 1308
1303(defun gdb-frames-select () 1309(defun gdb-frames-select ()
1304 "Make the frame on the current line become the current frame and display the 1310 "Select the frame and display the relevant source."
1305source in the source buffer."
1306 (interactive) 1311 (interactive)
1307 (gdb-enqueue-input 1312 (gdb-enqueue-input
1308 (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore)) 1313 (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore))
1309 (gud-display-frame)) 1314 (gud-display-frame))
1310 1315
1311(defun gdb-frames-mouse-select (event) 1316(defun gdb-frames-mouse-select (event)
1312 "Make the selected frame become the current frame and display the source in 1317 "Select the frame you click on and display the relevant source."
1313the source buffer."
1314 (interactive "e") 1318 (interactive "e")
1315 (mouse-set-point event) 1319 (mouse-set-point event)
1316 (gdb-frames-select)) 1320 (gdb-frames-select))
@@ -1343,11 +1347,13 @@ the source buffer."
1343 (concat "*threads of " (gdb-get-target-string) "*"))) 1347 (concat "*threads of " (gdb-get-target-string) "*")))
1344 1348
1345(defun gdb-display-threads-buffer () 1349(defun gdb-display-threads-buffer ()
1350 "Display IDs of currently known threads."
1346 (interactive) 1351 (interactive)
1347 (gdb-display-buffer 1352 (gdb-display-buffer
1348 (gdb-get-create-buffer 'gdb-threads-buffer))) 1353 (gdb-get-create-buffer 'gdb-threads-buffer)))
1349 1354
1350(defun gdb-frame-threads-buffer () 1355(defun gdb-frame-threads-buffer ()
1356 "Display IDs of currently known threads in a new frame."
1351 (interactive) 1357 (interactive)
1352 (select-frame (make-frame gdb-frame-parameters)) 1358 (select-frame (make-frame gdb-frame-parameters))
1353 (switch-to-buffer (gdb-get-create-buffer 'gdb-threads-buffer)) 1359 (switch-to-buffer (gdb-get-create-buffer 'gdb-threads-buffer))
@@ -1376,16 +1382,14 @@ the source buffer."
1376 (match-string-no-properties 1))) 1382 (match-string-no-properties 1)))
1377 1383
1378(defun gdb-threads-select () 1384(defun gdb-threads-select ()
1379 "Make the thread on the current line become the current thread and display the 1385 "Select the thread and display the relevant source."
1380source in the source buffer."
1381 (interactive) 1386 (interactive)
1382 (gdb-enqueue-input 1387 (gdb-enqueue-input
1383 (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore)) 1388 (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore))
1384 (gud-display-frame)) 1389 (gud-display-frame))
1385 1390
1386(defun gdb-threads-mouse-select (event) 1391(defun gdb-threads-mouse-select (event)
1387 "Make the selected frame become the current frame and display the source in 1392 "Select the thread you click on and display the relevant source."
1388the source buffer."
1389 (interactive "e") 1393 (interactive "e")
1390 (mouse-set-point event) 1394 (mouse-set-point event)
1391 (gdb-threads-select)) 1395 (gdb-threads-select))
@@ -1425,11 +1429,13 @@ the source buffer."
1425 (concat "*registers of " (gdb-get-target-string) "*"))) 1429 (concat "*registers of " (gdb-get-target-string) "*")))
1426 1430
1427(defun gdb-display-registers-buffer () 1431(defun gdb-display-registers-buffer ()
1432 "Display integer register contents."
1428 (interactive) 1433 (interactive)
1429 (gdb-display-buffer 1434 (gdb-display-buffer
1430 (gdb-get-create-buffer 'gdb-registers-buffer))) 1435 (gdb-get-create-buffer 'gdb-registers-buffer)))
1431 1436
1432(defun gdb-frame-registers-buffer () 1437(defun gdb-frame-registers-buffer ()
1438 "Display integer register contents in a new frame."
1433 (interactive) 1439 (interactive)
1434 (select-frame (make-frame gdb-frame-parameters)) 1440 (select-frame (make-frame gdb-frame-parameters))
1435 (switch-to-buffer (gdb-get-create-buffer 'gdb-registers-buffer)) 1441 (switch-to-buffer (gdb-get-create-buffer 'gdb-registers-buffer))
@@ -1497,11 +1503,13 @@ the source buffer."
1497 (concat "*locals of " (gdb-get-target-string) "*"))) 1503 (concat "*locals of " (gdb-get-target-string) "*")))
1498 1504
1499(defun gdb-display-locals-buffer () 1505(defun gdb-display-locals-buffer ()
1506 "Display local variables of current stack and their values."
1500 (interactive) 1507 (interactive)
1501 (gdb-display-buffer 1508 (gdb-display-buffer
1502 (gdb-get-create-buffer 'gdb-locals-buffer))) 1509 (gdb-get-create-buffer 'gdb-locals-buffer)))
1503 1510
1504(defun gdb-frame-locals-buffer () 1511(defun gdb-frame-locals-buffer ()
1512 "Display local variables of current stack and their values in a new frame."
1505 (interactive) 1513 (interactive)
1506 (select-frame (make-frame gdb-frame-parameters)) 1514 (select-frame (make-frame gdb-frame-parameters))
1507 (switch-to-buffer (gdb-get-create-buffer 'gdb-locals-buffer)) 1515 (switch-to-buffer (gdb-get-create-buffer 'gdb-locals-buffer))
@@ -1524,7 +1532,7 @@ the source buffer."
1524 #'(lambda (win) 1532 #'(lambda (win)
1525 (if (eq gud-comint-buffer (window-buffer win)) 1533 (if (eq gud-comint-buffer (window-buffer win))
1526 (set-window-dedicated-p win t)))) 1534 (set-window-dedicated-p win t))))
1527 (setq answer (get-buffer-window buf)) 1535 (setq answer (get-buffer-window buf 'visible))
1528 (if (not answer) 1536 (if (not answer)
1529 (let ((window (get-lru-window 'visible))) 1537 (let ((window (get-lru-window 'visible)))
1530 (if window 1538 (if window
@@ -1548,7 +1556,7 @@ the source buffer."
1548 (if (eq gdb-selected-view 'source) 1556 (if (eq gdb-selected-view 'source)
1549 (gdb-display-buffer buffer) 1557 (gdb-display-buffer buffer)
1550 (gdb-display-buffer (gdb-get-buffer 'gdb-assembler-buffer))) 1558 (gdb-display-buffer (gdb-get-buffer 'gdb-assembler-buffer)))
1551 (get-buffer-window buffer)) 1559 (get-buffer-window buffer 'visible))
1552 1560
1553 1561
1554;;; Shared keymap initialization: 1562;;; Shared keymap initialization:
@@ -1557,11 +1565,11 @@ the source buffer."
1557 (define-key gud-menu-map [frames] 1565 (define-key gud-menu-map [frames]
1558 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba))) 1566 `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba)))
1559 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) 1567 (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer))
1560 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) 1568 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
1561 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) 1569 (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer))
1570 (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer))
1562 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)) 1571 (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer))
1563 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer)) 1572 (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer))
1564 (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer))
1565; (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer)) 1573; (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer))
1566) 1574)
1567 1575
@@ -1569,11 +1577,11 @@ the source buffer."
1569 (define-key gud-menu-map [displays] 1577 (define-key gud-menu-map [displays]
1570 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba))) 1578 `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba)))
1571 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) 1579 (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer))
1572 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) 1580 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
1573 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) 1581 (define-key menu [registers] '("Registers" . gdb-display-registers-buffer))
1582 (define-key menu [locals] '("Locals" . gdb-display-locals-buffer))
1574 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) 1583 (define-key menu [frames] '("Stack" . gdb-display-stack-buffer))
1575 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer)) 1584 (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer))
1576 (define-key menu [threads] '("Threads" . gdb-display-threads-buffer))
1577; (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer)) 1585; (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer))
1578) 1586)
1579 1587
@@ -1601,12 +1609,14 @@ the source buffer."
1601 "Display locals, stack and breakpoint information"))) 1609 "Display locals, stack and breakpoint information")))
1602 1610
1603(defun gdb-frame-gdb-buffer () 1611(defun gdb-frame-gdb-buffer ()
1612 "Display GUD buffer in a new frame."
1604 (interactive) 1613 (interactive)
1605 (select-frame (make-frame gdb-frame-parameters)) 1614 (select-frame (make-frame gdb-frame-parameters))
1606 (switch-to-buffer (gdb-get-create-buffer 'gdba)) 1615 (switch-to-buffer (gdb-get-create-buffer 'gdba))
1607 (set-window-dedicated-p (selected-window) t)) 1616 (set-window-dedicated-p (selected-window) t))
1608 1617
1609(defun gdb-display-gdb-buffer () 1618(defun gdb-display-gdb-buffer ()
1619 "Display GUD buffer."
1610 (interactive) 1620 (interactive)
1611 (gdb-display-buffer 1621 (gdb-display-buffer
1612 (gdb-get-create-buffer 'gdba))) 1622 (gdb-get-create-buffer 'gdba)))
@@ -1614,6 +1624,7 @@ the source buffer."
1614(defvar gdb-main-file nil "Source file from which program execution begins.") 1624(defvar gdb-main-file nil "Source file from which program execution begins.")
1615 1625
1616(defun gdb-view-source-function () 1626(defun gdb-view-source-function ()
1627 "Select source view."
1617 (interactive) 1628 (interactive)
1618 (if gdb-view-source 1629 (if gdb-view-source
1619 (gdb-display-buffer 1630 (gdb-display-buffer
@@ -1623,6 +1634,7 @@ the source buffer."
1623 (setq gdb-selected-view 'source)) 1634 (setq gdb-selected-view 'source))
1624 1635
1625(defun gdb-view-assembler() 1636(defun gdb-view-assembler()
1637 "Select disassembly view."
1626 (interactive) 1638 (interactive)
1627 (gdb-display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)) 1639 (gdb-display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))
1628 (gdb-invalidate-assembler) 1640 (gdb-invalidate-assembler)
@@ -1805,11 +1817,10 @@ BUFFER nil or omitted means use the current buffer."
1805 (when (< left-margin-width 2) 1817 (when (< left-margin-width 2)
1806 (save-current-buffer 1818 (save-current-buffer
1807 (setq left-margin-width 2) 1819 (setq left-margin-width 2)
1808 (if (get-buffer-window (current-buffer)) 1820 (if (get-buffer-window (current-buffer) 'visible)
1809 (set-window-margins (get-buffer-window 1821 (set-window-margins
1810 (current-buffer)) 1822 (get-buffer-window (current-buffer) 'visible)
1811 left-margin-width 1823 left-margin-width right-margin-width))))
1812 right-margin-width))))
1813 (put-image 1824 (put-image
1814 (if enabled 1825 (if enabled
1815 (or breakpoint-enabled-icon 1826 (or breakpoint-enabled-icon
@@ -1833,11 +1844,10 @@ BUFFER nil or omitted means use the current buffer."
1833 (when (< left-margin-width 2) 1844 (when (< left-margin-width 2)
1834 (save-current-buffer 1845 (save-current-buffer
1835 (setq left-margin-width 2) 1846 (setq left-margin-width 2)
1836 (if (get-buffer-window (current-buffer)) 1847 (if (get-buffer-window (current-buffer) 'visible)
1837 (set-window-margins (get-buffer-window 1848 (set-window-margins
1838 (current-buffer)) 1849 (get-buffer-window (current-buffer) 'visible)
1839 left-margin-width 1850 left-margin-width right-margin-width))))
1840 right-margin-width))))
1841 (gdb-put-string (if enabled "B" "b") (1+ start))))) 1851 (gdb-put-string (if enabled "B" "b") (1+ start)))))
1842 1852
1843(defun gdb-remove-breakpoint-icons (start end &optional remove-margin) 1853(defun gdb-remove-breakpoint-icons (start end &optional remove-margin)
@@ -1846,11 +1856,10 @@ BUFFER nil or omitted means use the current buffer."
1846 (remove-images start end)) 1856 (remove-images start end))
1847 (when remove-margin 1857 (when remove-margin
1848 (setq left-margin-width 0) 1858 (setq left-margin-width 0)
1849 (if (get-buffer-window (current-buffer)) 1859 (if (get-buffer-window (current-buffer) 'visible)
1850 (set-window-margins (get-buffer-window 1860 (set-window-margins
1851 (current-buffer)) 1861 (get-buffer-window (current-buffer) 'visible)
1852 left-margin-width 1862 left-margin-width right-margin-width))))
1853 right-margin-width))))
1854 1863
1855 1864
1856;; 1865;;
@@ -1901,7 +1910,7 @@ BUFFER nil or omitted means use the current buffer."
1901 (if (re-search-forward address nil t) 1910 (if (re-search-forward address nil t)
1902 (gdb-put-breakpoint-icon (eq flag ?y)))))))) 1911 (gdb-put-breakpoint-icon (eq flag ?y))))))))
1903 (if (not (equal gdb-current-address "main")) 1912 (if (not (equal gdb-current-address "main"))
1904 (set-window-point (get-buffer-window buffer) pos)))) 1913 (set-window-point (get-buffer-window buffer 'visible) pos))))
1905 1914
1906(defvar gdb-assembler-mode-map 1915(defvar gdb-assembler-mode-map
1907 (let ((map (make-sparse-keymap))) 1916 (let ((map (make-sparse-keymap)))
@@ -1927,11 +1936,13 @@ BUFFER nil or omitted means use the current buffer."
1927 (concat "*Machine Code " (gdb-get-target-string) "*"))) 1936 (concat "*Machine Code " (gdb-get-target-string) "*")))
1928 1937
1929(defun gdb-display-assembler-buffer () 1938(defun gdb-display-assembler-buffer ()
1939 "Display disassembly view."
1930 (interactive) 1940 (interactive)
1931 (gdb-display-buffer 1941 (gdb-display-buffer
1932 (gdb-get-create-buffer 'gdb-assembler-buffer))) 1942 (gdb-get-create-buffer 'gdb-assembler-buffer)))
1933 1943
1934(defun gdb-frame-assembler-buffer () 1944(defun gdb-frame-assembler-buffer ()
1945 "Display disassembly view in a new frame."
1935 (interactive) 1946 (interactive)
1936 (select-frame (make-frame gdb-frame-parameters)) 1947 (select-frame (make-frame gdb-frame-parameters))
1937 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)) 1948 (switch-to-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))
diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el
index 9eaba9027b8..0fdaf652e50 100644
--- a/lisp/progmodes/python.el
+++ b/lisp/progmodes/python.el
@@ -46,19 +46,18 @@
46;; I've installed a minor mode to do the job properly in Emacs 22. 46;; I've installed a minor mode to do the job properly in Emacs 22.
47;; Other things seem more natural or canonical here, e.g. the 47;; Other things seem more natural or canonical here, e.g. the
48;; {beginning,end}-of-defun implementation dealing with nested 48;; {beginning,end}-of-defun implementation dealing with nested
49;; definitions, and the inferior mode following `cmuscheme'. (The 49;; definitions, and the inferior mode following `cmuscheme'. The
50;; inferior mode should be able to find the source of errors from 50;; inferior mode can find the source of errors from
51;; `python-send-region' & al via `compilation-minor-mode', but I can't 51;; `python-send-region' & al via `compilation-minor-mode'. Successive
52;; make that work with the current (March '04) compile.el.) 52;; TABs cycle between possible indentations for the line. There is
53;; Successive TABs cycle between possible indentations for the line. 53;; symbol completion using lookup in Python.
54 54
55;; Even where it has similar facilities, this is incompatible with 55;; Even where it has similar facilities, this is incompatible with
56;; python-mode.el in various respects. For instance, various key 56;; python-mode.el in various respects. For instance, various key
57;; bindings are changed to obey Emacs conventions, and things like 57;; bindings are changed to obey Emacs conventions, and things like
58;; marking blocks and `beginning-of-defun' behave differently. 58;; marking blocks and `beginning-of-defun' behave differently.
59 59
60;; TODO: See various Fixmes below. It should be possible to arrange 60;; TODO: See various Fixmes below.
61;; some sort of completion using the inferior interpreter.
62 61
63;;; Code: 62;;; Code:
64 63
@@ -203,6 +202,8 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
203 (define-key map "\C-c\C-z" 'python-switch-to-python) 202 (define-key map "\C-c\C-z" 'python-switch-to-python)
204 (define-key map "\C-c\C-m" 'python-load-file) 203 (define-key map "\C-c\C-m" 'python-load-file)
205 (define-key map "\C-c\C-l" 'python-load-file) ; a la cmuscheme 204 (define-key map "\C-c\C-l" 'python-load-file) ; a la cmuscheme
205 (substitute-key-definition 'complete-symbol 'python-complete-symbol
206 map global-map)
206 ;; Fixme: Add :help to menu. 207 ;; Fixme: Add :help to menu.
207 (easy-menu-define python-menu map "Python Mode menu" 208 (easy-menu-define python-menu map "Python Mode menu"
208 '("Python" 209 '("Python"
@@ -261,9 +262,7 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)."
261;;;; Utility stuff 262;;;; Utility stuff
262 263
263(defsubst python-in-string/comment () 264(defsubst python-in-string/comment ()
264 "Return non-nil if point is in a Python literal (a comment or string). 265 "Return non-nil if point is in a Python literal (a comment or string)."
265Optional argument LIM indicates the beginning of the containing form,
266i.e. the limit on how far back to scan."
267 (syntax-ppss-context (syntax-ppss))) 266 (syntax-ppss-context (syntax-ppss)))
268 267
269(defconst python-space-backslash-table 268(defconst python-space-backslash-table
@@ -300,14 +299,17 @@ comments and strings, or that the bracket/paren nesting depth is nonzero."
300(defun python-comment-line-p () 299(defun python-comment-line-p ()
301 "Return non-nil if current line has only a comment or is blank." 300 "Return non-nil if current line has only a comment or is blank."
302 (save-excursion 301 (save-excursion
303 (back-to-indentation) 302 (end-of-line)
304 (looking-at (rx (or (syntax comment-start) line-end))))) 303 ;; FIXME: This looks wrong because it returns nil for empty lines. --Stef
304 (when (eq 'comment (syntax-ppss-context (syntax-ppss)))
305 (back-to-indentation)
306 (looking-at (rx (or (syntax comment-start) line-end))))))
305 307
306(defun python-beginning-of-string () 308(defun python-beginning-of-string ()
307 "Go to beginning of string around point. 309 "Go to beginning of string around point.
308Do nothing if not in string." 310Do nothing if not in string."
309 (let ((state (syntax-ppss))) 311 (let ((state (syntax-ppss)))
310 (when (nth 3 state) 312 (when (eq 'string (syntax-ppss-context state))
311 (goto-char (nth 8 state))))) 313 (goto-char (nth 8 state)))))
312 314
313(defun python-open-block-statement-p (&optional bos) 315(defun python-open-block-statement-p (&optional bos)
@@ -383,7 +385,8 @@ Otherwise indent them to column zero."
383(defcustom python-honour-comment-indentation nil 385(defcustom python-honour-comment-indentation nil
384 "Non-nil means indent relative to preceding comment line. 386 "Non-nil means indent relative to preceding comment line.
385Only do this for comments where the leading comment character is followed 387Only do this for comments where the leading comment character is followed
386by space." 388by space. This doesn't apply to comment lines, which are always indented
389in lines with preceding comments."
387 :type 'boolean 390 :type 'boolean
388 :group 'python) 391 :group 'python)
389 392
@@ -513,6 +516,16 @@ Set `python-indent' locally to the value guessed."
513 (- python-indent))) 516 (- python-indent)))
514 0))))))))) 517 0)))))))))
515 518
519(defun python-comment-indent ()
520 "`comment-indent-function' for Python."
521 ;; If previous non-blank line was a comment, use its indentation.
522 ;; FIXME: This seems unnecessary since the default code delegates to
523 ;; indent-according-to-mode. --Stef
524 (unless (bobp)
525 (save-excursion
526 (forward-comment -1)
527 (if (eq ?# (char-after)) (current-column)))))
528
516;;;; Cycling through the possible indentations with successive TABs. 529;;;; Cycling through the possible indentations with successive TABs.
517 530
518;; These don't need to be buffer-local since they're only relevant 531;; These don't need to be buffer-local since they're only relevant
@@ -537,11 +550,17 @@ Set `python-indent' locally to the value guessed."
537 (point)))) 550 (point))))
538 551
539(defun python-indentation-levels () 552(defun python-indentation-levels ()
540 "Return a list of possible indentations for this statement. 553 "Return a list of possible indentations for this line.
541Includes the default indentation and those which would close all 554Includes the default indentation and those which would close all
542enclosing blocks." 555enclosing blocks. Assumes the line has already been indented per
556`python-indent-line'. Elements of the list are actually pairs:
557\(INDENTATION . TEXT), where TEXT is the initial text of the
558corresponding block opening (or nil)."
543 (save-excursion 559 (save-excursion
544 (let ((levels (list (cons (current-indentation) nil)))) 560 (let ((levels (list (cons (current-indentation)
561 (save-excursion
562 (if (python-beginning-of-block)
563 (python-initial-text)))))))
545 ;; Only one possibility if we immediately follow a block open or 564 ;; Only one possibility if we immediately follow a block open or
546 ;; are in a continuation line. 565 ;; are in a continuation line.
547 (unless (or (python-continuation-line-p) 566 (unless (or (python-continuation-line-p)
@@ -567,8 +586,7 @@ enclosing blocks."
567 (if (> (- (point-max) pos) (point)) 586 (if (> (- (point-max) pos) (point))
568 (goto-char (- (point-max) pos)))))) 587 (goto-char (- (point-max) pos))))))
569 588
570;; Fixme: Is the arg necessary? 589(defun python-indent-line ()
571(defun python-indent-line (&optional arg)
572 "Indent current line as Python code. 590 "Indent current line as Python code.
573When invoked via `indent-for-tab-command', cycle through possible 591When invoked via `indent-for-tab-command', cycle through possible
574indentations for current line. The cycle is broken by a command different 592indentations for current line. The cycle is broken by a command different
@@ -585,13 +603,30 @@ from `indent-for-tab-command', i.e. successive TABs do the cycling."
585 (beginning-of-line) 603 (beginning-of-line)
586 (delete-horizontal-space) 604 (delete-horizontal-space)
587 (indent-to (car (nth python-indent-index python-indent-list))) 605 (indent-to (car (nth python-indent-index python-indent-list)))
588 (let ((text (cdr (nth python-indent-index 606 (if (python-block-end-p)
589 python-indent-list)))) 607 (let ((text (cdr (nth python-indent-index
590 (if text (message "Closes: %s" text))))) 608 python-indent-list))))
609 (if text
610 (message "Closes: %s" text))))))
591 (python-indent-line-1) 611 (python-indent-line-1)
592 (setq python-indent-list (python-indentation-levels) 612 (setq python-indent-list (python-indentation-levels)
593 python-indent-list-length (length python-indent-list) 613 python-indent-list-length (length python-indent-list)
594 python-indent-index (1- python-indent-list-length))))) 614 python-indent-index (1- python-indent-list-length)))))
615
616(defun python-block-end-p ()
617 "Non-nil if this is a line in a statement closing a block,
618or a blank line indented to where it would close a block."
619 (and (not (python-comment-line-p))
620 (or (python-close-block-statement-p t)
621 (< (current-indentation)
622 (save-excursion
623 (python-previous-statement)
624 (current-indentation))))))
625
626;; Fixme: Define an indent-region-function. It should probably leave
627;; lines alone if the indentation is already at one of the allowed
628;; levels. Otherwise, M-C-\ typically keeps indenting more deeply
629;; down a function.
595 630
596;;;; Movement. 631;;;; Movement.
597 632
@@ -628,8 +663,7 @@ start of buffer."
628 "`end-of-defun-function' for Python. 663 "`end-of-defun-function' for Python.
629Finds end of innermost nested class or method definition." 664Finds end of innermost nested class or method definition."
630 (let ((orig (point)) 665 (let ((orig (point))
631 (pattern (rx (and line-start (0+ space) 666 (pattern (rx (and line-start (0+ space) (or "def" "class") space))))
632 (or "def" "class") space))))
633 ;; Go to start of current block and check whether it's at top 667 ;; Go to start of current block and check whether it's at top
634 ;; level. If it is, and not a block start, look forward for 668 ;; level. If it is, and not a block start, look forward for
635 ;; definition statement. 669 ;; definition statement.
@@ -914,13 +948,20 @@ See `python-check-command' for the default."
914 (file-name-nondirectory name)))))))) 948 (file-name-nondirectory name))))))))
915 (setq python-saved-check-command command) 949 (setq python-saved-check-command command)
916 (save-some-buffers (not compilation-ask-about-save) nil) 950 (save-some-buffers (not compilation-ask-about-save) nil)
917 (compilation-start command)) 951 (let ((compilation-error-regexp-alist
952 (cons '("(\\([^,]+\\), line \\([0-9]+\\))" 1 2)
953 compilation-error-regexp-alist)))
954 (compilation-start command)))
918 955
919;;;; Inferior mode stuff (following cmuscheme). 956;;;; Inferior mode stuff (following cmuscheme).
920 957
958;; Fixme: Make sure we can work with IPython.
959
921(defcustom python-python-command "python" 960(defcustom python-python-command "python"
922 "*Shell command to run Python interpreter. 961 "*Shell command to run Python interpreter.
923Any arguments can't contain whitespace." 962Any arguments can't contain whitespace.
963Note that IPython may not work properly; it must at least be used with the
964`-cl' flag, i.e. use `ipython -cl'."
924 :group 'python 965 :group 'python
925 :type 'string) 966 :type 'string)
926 967
@@ -970,12 +1011,31 @@ et al.")
970 ) 1011 )
971 1012
972(defconst python-compilation-regexp-alist 1013(defconst python-compilation-regexp-alist
1014 ;; FIXME: maybe these should move to compilation-error-regexp-alist-alist.
973 `((,(rx (and line-start (1+ (any " \t")) "File \"" 1015 `((,(rx (and line-start (1+ (any " \t")) "File \""
974 (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c 1016 (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c
975 "\", line " (group (1+ digit)))) 1017 "\", line " (group (1+ digit))))
976 1 python-compilation-line-number)) 1018 1 2)
1019 (,(rx (and " in file " (group (1+ not-newline)) " on line "
1020 (group (1+ digit))))
1021 1 2))
977 "`compilation-error-regexp-alist' for inferior Python.") 1022 "`compilation-error-regexp-alist' for inferior Python.")
978 1023
1024(defvar inferior-python-mode-map
1025 (let ((map (make-sparse-keymap)))
1026 ;; This will inherit from comint-mode-map.
1027 (define-key map "\C-c\C-l" 'python-load-file)
1028 (define-key map "\C-c\C-z" 'python-switch-to-python) ;What for? --Stef
1029 (define-key map "\C-c\C-v" 'python-check)
1030 ;; Note that we _can_ still use these commands which send to the
1031 ;; Python process even at the prompt iff we have a normal prompt,
1032 ;; i.e. '>>> ' and not '... '. See the comment before
1033 ;; python-send-region. Fixme: uncomment these if we address that.
1034
1035 ;; (define-key map [(meta ?\t)] 'python-complete-symbol)
1036 ;; (define-key map "\C-c\C-f" 'python-describe-symbol)
1037 map))
1038
979;; Fixme: This should inherit some stuff from python-mode, but I'm not 1039;; Fixme: This should inherit some stuff from python-mode, but I'm not
980;; sure how much: at least some keybindings, like C-c C-f; syntax?; 1040;; sure how much: at least some keybindings, like C-c C-f; syntax?;
981;; font-locking, e.g. for triple-quoted strings? 1041;; font-locking, e.g. for triple-quoted strings?
@@ -999,15 +1059,13 @@ For running multiple processes in multiple buffers, see `python-buffer'.
999 :group 'python 1059 :group 'python
1000 (set-syntax-table python-mode-syntax-table) 1060 (set-syntax-table python-mode-syntax-table)
1001 (setq mode-line-process '(":%s")) 1061 (setq mode-line-process '(":%s"))
1002 ;; Fixme: Maybe install some python-mode bindings too. 1062 (set (make-local-variable 'comint-input-filter) 'python-input-filter)
1003 (define-key inferior-python-mode-map "\C-c\C-l" 'python-load-file)
1004 (define-key inferior-python-mode-map "\C-c\C-z" 'python-switch-to-python)
1005 (add-hook 'comint-input-filter-functions 'python-input-filter nil t)
1006 (add-hook 'comint-preoutput-filter-functions #'python-preoutput-filter 1063 (add-hook 'comint-preoutput-filter-functions #'python-preoutput-filter
1007 nil t) 1064 nil t)
1008 ;; Still required by `comint-redirect-send-command', for instance 1065 ;; Still required by `comint-redirect-send-command', for instance
1009 ;; (and we need to match things like `>>> ... >>> '): 1066 ;; (and we need to match things like `>>> ... >>> '):
1010 (set (make-local-variable 'comint-prompt-regexp) "^\\([>.]\\{3\\} \\)+") 1067 (set (make-local-variable 'comint-prompt-regexp)
1068 (rx (and line-start (1+ (and (repeat 3 (any ">.")) ?\ )))))
1011 (set (make-local-variable 'compilation-error-regexp-alist) 1069 (set (make-local-variable 'compilation-error-regexp-alist)
1012 python-compilation-regexp-alist) 1070 python-compilation-regexp-alist)
1013 (compilation-shell-minor-mode 1)) 1071 (compilation-shell-minor-mode 1))
@@ -1018,15 +1076,9 @@ Default ignores all inputs of 0, 1, or 2 non-blank characters."
1018 :type 'regexp 1076 :type 'regexp
1019 :group 'python) 1077 :group 'python)
1020 1078
1021(defvar python-orig-start nil
1022 "Marker to the start of the region passed to the inferior Python.
1023It can also be a filename.")
1024
1025(defun python-input-filter (str) 1079(defun python-input-filter (str)
1026 "`comint-input-filter' function for inferior Python. 1080 "`comint-input-filter' function for inferior Python.
1027Don't save anything for STR matching `inferior-python-filter-regexp'. 1081Don't save anything for STR matching `inferior-python-filter-regexp'."
1028Also resets variables for adjusting error messages."
1029 (setq python-orig-start nil)
1030 (not (string-match inferior-python-filter-regexp str))) 1082 (not (string-match inferior-python-filter-regexp str)))
1031 1083
1032;; Fixme: Loses with quoted whitespace. 1084;; Fixme: Loses with quoted whitespace.
@@ -1039,25 +1091,8 @@ Also resets variables for adjusting error messages."
1039 (t (let ((pos (string-match "[^ \t]" string))) 1091 (t (let ((pos (string-match "[^ \t]" string)))
1040 (if pos (python-args-to-list (substring string pos)))))))) 1092 (if pos (python-args-to-list (substring string pos))))))))
1041 1093
1042(defun python-compilation-line-number (file col)
1043 "Return error descriptor of error found for FILE, column COL.
1044Used as line-number hook function in `python-compilation-regexp-alist'."
1045 (let ((line (string-to-number (match-string 2))))
1046 (cons (point-marker)
1047 (if (and (markerp python-orig-start)
1048 (marker-buffer python-orig-start))
1049 (let ((start python-orig-start))
1050 (with-current-buffer (marker-buffer python-orig-start)
1051 (goto-char start)
1052 (forward-line (1- line))
1053 (point-marker)))
1054 (list (if (stringp python-orig-start)
1055 (list python-orig-start default-directory)
1056 file)
1057 line col)))))
1058
1059(defvar python-preoutput-result nil 1094(defvar python-preoutput-result nil
1060 "Data from output line last `_emacs_out' line seen by the preoutput filter.") 1095 "Data from last `_emacs_out' line seen by the preoutput filter.")
1061 1096
1062(defvar python-preoutput-continuation nil 1097(defvar python-preoutput-continuation nil
1063 "If non-nil, funcall this when `python-preoutput-filter' sees `_emacs_ok'.") 1098 "If non-nil, funcall this when `python-preoutput-filter' sees `_emacs_ok'.")
@@ -1068,7 +1103,9 @@ Used as line-number hook function in `python-compilation-regexp-alist'."
1068;; `python-preoutput-continuation' if we get it. 1103;; `python-preoutput-continuation' if we get it.
1069(defun python-preoutput-filter (s) 1104(defun python-preoutput-filter (s)
1070 "`comint-preoutput-filter-functions' function: ignore prompts not at bol." 1105 "`comint-preoutput-filter-functions' function: ignore prompts not at bol."
1071 (cond ((and (string-match "\\`[.>]\\{3\\} \\'" s) 1106 (cond ((and (string-match (rx (and string-start (repeat 3 (any ".>"))
1107 " " string-end))
1108 s)
1072 (/= (let ((inhibit-field-text-motion t)) 1109 (/= (let ((inhibit-field-text-motion t))
1073 (line-beginning-position)) 1110 (line-beginning-position))
1074 (point))) 1111 (point)))
@@ -1089,10 +1126,10 @@ Used as line-number hook function in `python-compilation-regexp-alist'."
1089CMD is the Python command to run. NOSHOW non-nil means don't show the 1126CMD is the Python command to run. NOSHOW non-nil means don't show the
1090buffer automatically. 1127buffer automatically.
1091If there is a process already running in `*Python*', switch to 1128If there is a process already running in `*Python*', switch to
1092that buffer. Interactively a prefix arg, allows you to edit the initial 1129that buffer. Interactively, a prefix arg allows you to edit the initial
1093command line (default is the value of `python-command'); `-i' etc. args 1130command line (default is `python-command'); `-i' etc. args will be added
1094will be added to this as appropriate. Runs the hooks 1131to this as appropriate. Runs the hook `inferior-python-mode-hook'
1095`inferior-python-mode-hook' (after the `comint-mode-hook' is run). 1132\(after the `comint-mode-hook' is run).
1096\(Type \\[describe-mode] in the process buffer for a list of commands.)" 1133\(Type \\[describe-mode] in the process buffer for a list of commands.)"
1097 (interactive (list (if current-prefix-arg 1134 (interactive (list (if current-prefix-arg
1098 (read-string "Run Python: " python-command) 1135 (read-string "Run Python: " python-command)
@@ -1102,47 +1139,34 @@ will be added to this as appropriate. Runs the hooks
1102 ;; Fixme: Consider making `python-buffer' buffer-local as a buffer 1139 ;; Fixme: Consider making `python-buffer' buffer-local as a buffer
1103 ;; (not a name) in Python buffers from which `run-python' &c is 1140 ;; (not a name) in Python buffers from which `run-python' &c is
1104 ;; invoked. Would support multiple processes better. 1141 ;; invoked. Would support multiple processes better.
1105 (unless (comint-check-proc "*Python*") 1142 (unless (comint-check-proc python-buffer)
1106 (let ((cmdlist (append (python-args-to-list cmd) '("-i")))) 1143 (let ((cmdlist (append (python-args-to-list cmd) '("-i")))
1144 (process-environment ; to import emacs.py
1145 (push (concat "PYTHONPATH=" data-directory)
1146 process-environment)))
1107 (set-buffer (apply 'make-comint "Python" (car cmdlist) nil 1147 (set-buffer (apply 'make-comint "Python" (car cmdlist) nil
1108 (cdr cmdlist)))) 1148 (cdr cmdlist)))
1149 (setq python-buffer "*Python*"))
1109 (inferior-python-mode) 1150 (inferior-python-mode)
1110 ;; Load function defintions we need. 1151 ;; Load function defintions we need.
1111 ;; Before the preoutput function was used, this was done via -c in 1152 ;; Before the preoutput function was used, this was done via -c in
1112 ;; cmdlist, but that loses the banner and doesn't run the startup 1153 ;; cmdlist, but that loses the banner and doesn't run the startup
1113 ;; file. 1154 ;; file. The code might be inline here, but there's enough that it
1114 (python-send-string "\ 1155 ;; seems worth putting in a separate file, and it's probably cleaner
1115def _emacs_execfile (file): # execute file and remove it 1156 ;; to put it in a module.
1116 from os import remove 1157 (python-send-string "import emacs"))
1117 try: execfile (file, globals (), globals ()) 1158 (unless noshow (pop-to-buffer python-buffer)))
1118 finally: remove (file) 1159
1119 1160;; Fixme: We typically lose if the inferior isn't in the normal REPL,
1120def _emacs_args (name): # get arglist of name for eldoc &c 1161;; e.g. prompt is `help> '. Probably raise an error if the form of
1121 import inspect 1162;; the prompt is unexpected; actually, it needs to be `>>> ', not
1122 parts = name.split ('.') 1163;; `... ', i.e. we're not inputting a block &c. However, this may not
1123 if len (parts) > 1: 1164;; be the place to do it, e.g. we might actually want to send commands
1124 try: exec 'import ' + parts[0] 1165;; having set up such a state.
1125 except: return None
1126 try: exec 'func='+name # lose if name is keyword or undefined
1127 except: return None
1128 if inspect.isbuiltin (func):
1129 doc = func.__doc__
1130 if doc.find (' ->') != -1:
1131 print '_emacs_out', doc.split (' ->')[0]
1132 elif doc.find ('\\n') != -1:
1133 print '_emacs_out', doc.split ('\\n')[0]
1134 return None
1135 if inspect.ismethod (func): func = func.im_func
1136 if not inspect.isfunction (func):
1137 return None
1138 (args, varargs, varkw, defaults) = inspect.getargspec (func)
1139 print '_emacs_out', func.__name__+inspect.formatargspec (args, varargs, varkw, defaults)
1140
1141print '_emacs_ok'"))
1142 (unless noshow (pop-to-buffer (setq python-buffer "*Python*"))))
1143 1166
1144(defun python-send-command (command) 1167(defun python-send-command (command)
1145 "Like `python-send-string' but resets `compilation-minor-mode'." 1168 "Like `python-send-string' but resets `compilation-minor-mode'."
1169 (goto-char (point-max))
1146 (let ((end (marker-position (process-mark (python-proc))))) 1170 (let ((end (marker-position (process-mark (python-proc)))))
1147 (compilation-forget-errors) 1171 (compilation-forget-errors)
1148 (python-send-string command) 1172 (python-send-string command)
@@ -1154,35 +1178,37 @@ print '_emacs_ok'"))
1154 ;; The region is evaluated from a temporary file. This avoids 1178 ;; The region is evaluated from a temporary file. This avoids
1155 ;; problems with blank lines, which have different semantics 1179 ;; problems with blank lines, which have different semantics
1156 ;; interactively and in files. It also saves the inferior process 1180 ;; interactively and in files. It also saves the inferior process
1157 ;; buffer filling up with interpreter prompts. We need a function 1181 ;; buffer filling up with interpreter prompts. We need a Python
1158 ;; to remove the temporary file when it has been evaluated, which 1182 ;; function to remove the temporary file when it has been evaluated
1159 ;; unfortunately means using a not-quite pristine interpreter 1183 ;; (though we could probably do it in Lisp with a Comint output
1160 ;; initially. Unfortunately we also get tracebacks which look like: 1184 ;; filter). This function also catches exceptions and truncates
1161 ;; 1185 ;; tracebacks not to mention the frame of the function itself.
1162 ;; >>> Traceback (most recent call last):
1163 ;; File "<stdin>", line 1, in ?
1164 ;; File "<string>", line 4, in _emacs_execfile
1165 ;; File "/tmp/py7734RSB", line 11
1166 ;; 1186 ;;
1167 ;; The compilation-minor-mode parsing takes care of relating the 1187 ;; The compilation-minor-mode parsing takes care of relating the
1168 ;; reference to the temporary file to the source. Fixme: 1188 ;; reference to the temporary file to the source.
1169 ;; comint-filter the first two lines of the traceback? 1189 ;;
1190 ;; Fixme: Write a `coding' header to the temp file if the region is
1191 ;; non-ASCII.
1170 (interactive "r") 1192 (interactive "r")
1171 (let* ((f (make-temp-file "py")) 1193 (let* ((f (make-temp-file "py"))
1172 (command (format "_emacs_execfile(%S)" f)) 1194 (command (format "emacs.eexecfile(%S)" f))
1173 (orig-start (copy-marker start))) 1195 (orig-start (copy-marker start)))
1174 (if (save-excursion 1196 (when (save-excursion
1175 (goto-char start) 1197 (goto-char start)
1176 (/= 0 (current-indentation))) ; need dummy block 1198 (/= 0 (current-indentation))) ; need dummy block
1177 (write-region "if True:\n" nil f nil 'nomsg)) 1199 (save-excursion
1200 (goto-char orig-start)
1201 ;; Wrong if we had indented code at buffer start.
1202 (set-marker orig-start (line-beginning-position 0)))
1203 (write-region "if True:\n" nil f nil 'nomsg))
1178 (write-region start end f t 'nomsg) 1204 (write-region start end f t 'nomsg)
1179 (when python-buffer 1205 (let ((proc (python-proc))) ;Make sure we're running a process.
1180 (with-current-buffer python-buffer 1206 (with-current-buffer python-buffer
1181 (set (make-local-variable 'python-orig-start) orig-start) 1207 (python-send-command command)
1182 (let ((comint-input-filter-functions 1208 ;; Tell compile.el to redirect error locations in file `f' to
1183 ;; Don't reset python-orig-start. 1209 ;; positions past marker `orig-start'. It has to be done *after*
1184 (remq 'python-input-filter comint-input-filter-functions))) 1210 ;; python-send-command's call to compilation-forget-errors.
1185 (python-send-command command)))))) 1211 (compilation-fake-loc orig-start f)))))
1186 1212
1187(defun python-send-string (string) 1213(defun python-send-string (string)
1188 "Evaluate STRING in inferior Python process." 1214 "Evaluate STRING in inferior Python process."
@@ -1195,6 +1221,8 @@ print '_emacs_ok'"))
1195 (interactive) 1221 (interactive)
1196 (python-send-region (point-min) (point-max))) 1222 (python-send-region (point-min) (point-max)))
1197 1223
1224;; Fixme: Try to define the function or class within the relevant
1225;; module, not just at top level.
1198(defun python-send-defun () 1226(defun python-send-defun ()
1199 "Send the current defun (class or method) to the inferior Python process." 1227 "Send the current defun (class or method) to the inferior Python process."
1200 (interactive) 1228 (interactive)
@@ -1241,11 +1269,11 @@ function location information for debugging, and supports users of
1241module-qualified names." 1269module-qualified names."
1242 (interactive (comint-get-source "Load Python file: " python-prev-dir/file 1270 (interactive (comint-get-source "Load Python file: " python-prev-dir/file
1243 python-source-modes 1271 python-source-modes
1244 t)) ; because execfile needs exact name 1272 t)) ; because execfile needs exact name
1245 (comint-check-source file-name) ; Check to see if buffer needs saved. 1273 (comint-check-source file-name) ; Check to see if buffer needs saving.
1246 (setq python-prev-dir/file (cons (file-name-directory file-name) 1274 (setq python-prev-dir/file (cons (file-name-directory file-name)
1247 (file-name-nondirectory file-name))) 1275 (file-name-nondirectory file-name)))
1248 (when python-buffer 1276 (let ((proc (python-proc))) ;Make sure we have a process.
1249 (with-current-buffer python-buffer 1277 (with-current-buffer python-buffer
1250 ;; Fixme: I'm not convinced by this logic from python-mode.el. 1278 ;; Fixme: I'm not convinced by this logic from python-mode.el.
1251 (python-send-command 1279 (python-send-command
@@ -1253,19 +1281,22 @@ module-qualified names."
1253 ;; Fixme: make sure the directory is in the path list 1281 ;; Fixme: make sure the directory is in the path list
1254 (let ((module (file-name-sans-extension 1282 (let ((module (file-name-sans-extension
1255 (file-name-nondirectory file-name)))) 1283 (file-name-nondirectory file-name))))
1256 (format "\ 1284 (format "emacs.eimport(%S,%S)"
1257if globals().has_key(%S): reload(%s) 1285 module (file-name-directory file-name)))
1258else: import %s 1286 (format "execfile(%S)" file-name)))
1259" module module module)) 1287 (message "%s loaded" file-name))))
1260 (format "execfile('%s')" file-name))))))
1261 1288
1262;; Fixme: Should this start a process if there isn't one? (Unlike cmuscheme.) 1289;; Fixme: If we need to start the process, wait until we've got the OK
1290;; from the startup.
1263(defun python-proc () 1291(defun python-proc ()
1264 "Return the current Python process. See variable `python-buffer'." 1292 "Return the current Python process.
1265 (let ((proc (get-buffer-process (if (eq major-mode 'inferior-python-mode) 1293See variable `python-buffer'. Starts a new process if necessary."
1266 (current-buffer) 1294 (or (if python-buffer
1267 python-buffer)))) 1295 (get-buffer-process (if (eq major-mode 'inferior-python-mode)
1268 (or proc (error "No current process. See variable `python-buffer'")))) 1296 (current-buffer)
1297 python-buffer)))
1298 (progn (run-python nil t)
1299 (python-proc))))
1269 1300
1270;;;; Context-sensitive help. 1301;;;; Context-sensitive help.
1271 1302
@@ -1277,33 +1308,46 @@ else: import %s
1277 "Syntax table giving `.' symbol syntax. 1308 "Syntax table giving `.' symbol syntax.
1278Otherwise inherits from `python-mode-syntax-table'.") 1309Otherwise inherits from `python-mode-syntax-table'.")
1279 1310
1311(defvar view-return-to-alist)
1312
1280;; Fixme: Should this actually be used instead of info-look, i.e. be 1313;; Fixme: Should this actually be used instead of info-look, i.e. be
1281;; bound to C-h S? 1314;; bound to C-h S? Can we use other pydoc stuff before python 2.2?
1282(defun python-describe-symbol (symbol) 1315(defun python-describe-symbol (symbol)
1283 "Get help on SYMBOL using `pydoc'. 1316 "Get help on SYMBOL using `help'.
1284Interactively, prompt for symbol." 1317Interactively, prompt for symbol.
1285 ;; Note that we do this in the inferior process, not a separate one to 1318
1319Symbol may be anything recognized by the interpreter's `help' command --
1320e.g. `CALLS' -- not just variables in scope.
1321This only works for Python version 2.2 or newer since earlier interpreters
1322don't support `help'."
1323 ;; Note that we do this in the inferior process, not a separate one, to
1286 ;; ensure the environment is appropriate. 1324 ;; ensure the environment is appropriate.
1287 (interactive 1325 (interactive
1288 (let ((symbol (with-syntax-table python-dotty-syntax-table 1326 (let ((symbol (with-syntax-table python-dotty-syntax-table
1289 (current-word))) 1327 (current-word)))
1290 (enable-recursive-minibuffers t) 1328 (enable-recursive-minibuffers t))
1291 val) 1329 (list (read-string (if symbol
1292 (setq val (read-string (if symbol 1330 (format "Describe symbol (default %s): " symbol)
1293 (format "Describe symbol (default %s): " 1331 "Describe symbol: ")
1294 symbol) 1332 nil nil symbol))))
1295 "Describe symbol: ")
1296 nil nil symbol))
1297 (list (or val symbol))))
1298 (if (equal symbol "") (error "No symbol")) 1333 (if (equal symbol "") (error "No symbol"))
1299 (let* ((func `(lambda () 1334 (let* ((func `(lambda ()
1300 (comint-redirect-send-command (format "help(%S)\n" ,symbol) 1335 (comint-redirect-send-command (format "emacs.ehelp(%S)\n"
1336 ,symbol)
1301 "*Help*" nil)))) 1337 "*Help*" nil))))
1302 ;; Ensure we have a suitable help buffer. 1338 ;; Ensure we have a suitable help buffer.
1303 (let (temp-buffer-show-hook) ; avoid xref stuff 1339 ;; Fixme: Maybe process `Related help topics' a la help xrefs and
1304 (with-output-to-temp-buffer "*Help*" 1340 ;; allow C-c C-f in help buffer.
1341 (let ((temp-buffer-show-hook ; avoid xref stuff
1342 (lambda ()
1343 (toggle-read-only 1)
1344 (setq view-return-to-alist
1345 (list (cons (selected-window) help-return-method))))))
1346 (help-setup-xref (list 'python-describe-symbol symbol))
1347 (with-output-to-temp-buffer (help-buffer)
1305 (with-current-buffer standard-output 1348 (with-current-buffer standard-output
1306 (set (make-local-variable 'comint-redirect-subvert-readonly) t)))) 1349 (set (make-local-variable 'comint-redirect-subvert-readonly) t)
1350 (print-help-return-message))))
1307 (if (and python-buffer (get-buffer python-buffer)) 1351 (if (and python-buffer (get-buffer python-buffer))
1308 (with-current-buffer python-buffer 1352 (with-current-buffer python-buffer
1309 (funcall func)) 1353 (funcall func))
@@ -1312,6 +1356,15 @@ Interactively, prompt for symbol."
1312 1356
1313(add-to-list 'debug-ignored-errors "^No symbol") 1357(add-to-list 'debug-ignored-errors "^No symbol")
1314 1358
1359(defun python-send-receive (string)
1360 "Send STRING to inferior Python (if any) and return result.
1361The result is what follows `_emacs_out' in the output (or nil)."
1362 (let ((proc (python-proc)))
1363 (python-send-string string)
1364 (setq python-preoutput-result nil)
1365 (accept-process-output proc 5)
1366 python-preoutput-result))
1367
1315;; Fixme: try to make it work with point in the arglist. Also, is 1368;; Fixme: try to make it work with point in the arglist. Also, is
1316;; there anything reasonable we can do with random methods? 1369;; there anything reasonable we can do with random methods?
1317;; (Currently only works with functions.) 1370;; (Currently only works with functions.)
@@ -1320,14 +1373,9 @@ Interactively, prompt for symbol."
1320Only works when point is in a function name, not its arglist, for instance. 1373Only works when point is in a function name, not its arglist, for instance.
1321Assumes an inferior Python is running." 1374Assumes an inferior Python is running."
1322 (let ((symbol (with-syntax-table python-dotty-syntax-table 1375 (let ((symbol (with-syntax-table python-dotty-syntax-table
1323 (current-word))) 1376 (current-word))))
1324 (proc (and python-buffer (python-proc)))) 1377 (when symbol
1325 (when (and proc symbol) 1378 (python-send-receive (format "emacs.eargs(%S)" symbol)))))
1326 (python-send-string
1327 (format "_emacs_args(%S)" symbol))
1328 (setq python-preoutput-result nil)
1329 (accept-process-output proc 1)
1330 python-preoutput-result)))
1331 1379
1332;;;; Info-look functionality. 1380;;;; Info-look functionality.
1333 1381
@@ -1530,11 +1578,97 @@ Uses `python-beginning-of-block', `python-end-of-block'."
1530 (python-end-of-block) 1578 (python-end-of-block)
1531 (exchange-point-and-mark)) 1579 (exchange-point-and-mark))
1532 1580
1581;;;; Completion.
1582
1583(defun python-symbol-completions (symbol)
1584 "Return a list of completions of the string SYMBOL from Python process.
1585The list is sorted."
1586 (when symbol
1587 (let ((completions
1588 (condition-case ()
1589 (car (read-from-string (python-send-receive
1590 (format "emacs.complete(%S)" symbol))))
1591 (error nil))))
1592 (sort
1593 ;; We can get duplicates from the above -- don't know why.
1594 (delete-dups completions)
1595 #'string<))))
1596
1597(defun python-partial-symbol ()
1598 "Return the partial symbol before point (for completion)."
1599 (let ((end (point))
1600 (start (save-excursion
1601 (and (re-search-backward
1602 (rx (and (or buffer-start (regexp "[^[:alnum:]._]"))
1603 (group (1+ (regexp "[[:alnum:]._]")))
1604 point))
1605 nil t)
1606 (match-beginning 1)))))
1607 (if start (buffer-substring-no-properties start end))))
1608
1609;; Fixme: We should have an abstraction of this sort of thing in the
1610;; core.
1611(defun python-complete-symbol ()
1612 "Perform completion on the Python symbol preceding point.
1613Repeating the command scrolls the completion window."
1614 (interactive)
1615 (let ((window (get-buffer-window "*Completions*")))
1616 (if (and (eq last-command this-command)
1617 window (window-live-p window) (window-buffer window)
1618 (buffer-name (window-buffer window)))
1619 (with-current-buffer (window-buffer window)
1620 (if (pos-visible-in-window-p (point-max) window)
1621 (set-window-start window (point-min))
1622 (save-selected-window
1623 (select-window window)
1624 (scroll-up))))
1625 ;; Do completion.
1626 (let* ((end (point))
1627 (symbol (python-partial-symbol))
1628 (completions (python-symbol-completions symbol))
1629 (completion (if completions
1630 (try-completion symbol completions))))
1631 (when symbol
1632 (cond ((eq completion t))
1633 ((null completion)
1634 (message "Can't find completion for \"%s\"" symbol)
1635 (ding))
1636 ((not (string= symbol completion))
1637 (delete-region (- end (length symbol)) end)
1638 (insert completion))
1639 (t
1640 (message "Making completion list...")
1641 (with-output-to-temp-buffer "*Completions*"
1642 (display-completion-list completions))
1643 (message "Making completion list...%s" "done"))))))))
1644
1645(eval-when-compile (require 'hippie-exp))
1646
1647(defun python-try-complete (old)
1648 "Completion function for Python for use with `hippie-expand'."
1649 (when (eq major-mode 'python-mode) ; though we only add it locally
1650 (unless old
1651 (let ((symbol (python-partial-symbol)))
1652 (he-init-string (- (point) (length symbol)) (point))
1653 (if (not (he-string-member he-search-string he-tried-table))
1654 (push he-search-string he-tried-table))
1655 (setq he-expand-list
1656 (and symbol (python-symbol-completions symbol)))))
1657 (while (and he-expand-list
1658 (he-string-member (car he-expand-list) he-tried-table))
1659 (pop he-expand-list))
1660 (if he-expand-list
1661 (progn
1662 (he-substitute-string (pop he-expand-list))
1663 t)
1664 (if old (he-reset-string))
1665 nil)))
1666
1533;;;; Modes. 1667;;;; Modes.
1534 1668
1535(defvar outline-heading-end-regexp) 1669(defvar outline-heading-end-regexp)
1536(defvar eldoc-print-current-symbol-info-function) 1670(defvar eldoc-print-current-symbol-info-function)
1537(defvar python-mode-running) 1671
1538;;;###autoload 1672;;;###autoload
1539(define-derived-mode python-mode fundamental-mode "Python" 1673(define-derived-mode python-mode fundamental-mode "Python"
1540 "Major mode for editing Python files. 1674 "Major mode for editing Python files.
@@ -1576,11 +1710,10 @@ lines count as headers.
1576 )) 1710 ))
1577 (set (make-local-variable 'parse-sexp-lookup-properties) t) 1711 (set (make-local-variable 'parse-sexp-lookup-properties) t)
1578 (set (make-local-variable 'comment-start) "# ") 1712 (set (make-local-variable 'comment-start) "# ")
1579 ;; Fixme: define a comment-indent-function? 1713 (set (make-local-variable 'comment-indent-function) #'python-comment-indent)
1580 (set (make-local-variable 'indent-line-function) #'python-indent-line) 1714 (set (make-local-variable 'indent-line-function) #'python-indent-line)
1581 (set (make-local-variable 'paragraph-start) "\\s-*$") 1715 (set (make-local-variable 'paragraph-start) "\\s-*$")
1582 (set (make-local-variable 'fill-paragraph-function) 1716 (set (make-local-variable 'fill-paragraph-function) 'python-fill-paragraph)
1583 'python-fill-paragraph)
1584 (set (make-local-variable 'require-final-newline) t) 1717 (set (make-local-variable 'require-final-newline) t)
1585 (set (make-local-variable 'add-log-current-defun-function) 1718 (set (make-local-variable 'add-log-current-defun-function)
1586 #'python-current-defun) 1719 #'python-current-defun)
@@ -1598,6 +1731,9 @@ lines count as headers.
1598 #'python-eldoc-function) 1731 #'python-eldoc-function)
1599 (add-hook 'eldoc-mode-hook 1732 (add-hook 'eldoc-mode-hook
1600 '(lambda () (run-python 0 t)) nil t) ; need it running 1733 '(lambda () (run-python 0 t)) nil t) ; need it running
1734 (if (featurep 'hippie-exp)
1735 (set (make-local-variable 'hippie-expand-try-functions-list)
1736 (cons 'python-try-complete hippie-expand-try-functions-list)))
1601 (unless font-lock-mode (font-lock-mode 1)) 1737 (unless font-lock-mode (font-lock-mode 1))
1602 (when python-guess-indent (python-guess-indent)) 1738 (when python-guess-indent (python-guess-indent))
1603 (set (make-local-variable 'python-command) python-python-command) 1739 (set (make-local-variable 'python-command) python-python-command)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 420b5f226b0..0e0d89b07e1 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -4,7 +4,7 @@
4 4
5;; Author: Alex Schroeder <alex@gnu.org> 5;; Author: Alex Schroeder <alex@gnu.org>
6;; Maintainer: Michael Mauger <mmaug@yahoo.com> 6;; Maintainer: Michael Mauger <mmaug@yahoo.com>
7;; Version: 2.0.0 7;; Version: 2.0.1
8;; Keywords: comm languages processes 8;; Keywords: comm languages processes
9;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el 9;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el
10;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode 10;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode
@@ -200,8 +200,11 @@
200;; Gregor Zych <zych@pool.informatik.rwth-aachen.de> 200;; Gregor Zych <zych@pool.informatik.rwth-aachen.de>
201;; nino <nino@inform.dk> 201;; nino <nino@inform.dk>
202;; Berend de Boer <berend@pobox.com> 202;; Berend de Boer <berend@pobox.com>
203;; Michael Mauger <mmaug@yahoo.com>
204;; Adam Jenkins <adam@thejenkins.org> 203;; Adam Jenkins <adam@thejenkins.org>
204;; Michael Mauger <mmaug@yahoo.com> -- improved product support
205;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support
206;; Harald Maier <maierh@myself.com> -- sql-send-string
207;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections
205 208
206 209
207 210
@@ -693,18 +696,6 @@ Starts `sql-interactive-mode' after doing some setup."
693 696
694;;; Variables which do not need customization 697;;; Variables which do not need customization
695 698
696(defvar sql-xemacs-p
697 (string-match "XEmacs\\|Lucid" emacs-version)
698 "Is this a non-GNU Emacs?")
699
700(defvar sql-emacs19-p
701 (string-match "GNU Emacs 19" emacs-version)
702 "Is this a GNU Emacs 19?")
703
704(defvar sql-emacs20-p
705 (string-match "20" emacs-version)
706 "Is this a GNU Emacs 20?")
707
708(defvar sql-user-history nil 699(defvar sql-user-history nil
709 "History of usernames used.") 700 "History of usernames used.")
710 701
@@ -876,9 +867,7 @@ Based on `comint-mode-map'.")
876 (modify-syntax-entry ?/ ". 14" table) 867 (modify-syntax-entry ?/ ". 14" table)
877 (modify-syntax-entry ?* ". 23" table) 868 (modify-syntax-entry ?* ". 23" table)
878 ;; double-dash starts comment 869 ;; double-dash starts comment
879 (if sql-xemacs-p 870 (modify-syntax-entry ?- ". 12b" table)
880 (modify-syntax-entry ?- ". 56" table)
881 (modify-syntax-entry ?- ". 12b" table))
882 ;; newline and formfeed end coments 871 ;; newline and formfeed end coments
883 (modify-syntax-entry ?\n "> b" table) 872 (modify-syntax-entry ?\n "> b" table)
884 (modify-syntax-entry ?\f "> b" table) 873 (modify-syntax-entry ?\f "> b" table)
@@ -905,25 +894,6 @@ The pattern matches the name in a CREATE, DROP or ALTER
905statement. The format of variable should be a valid 894statement. The format of variable should be a valid
906`font-lock-keywords' entry.") 895`font-lock-keywords' entry.")
907 896
908(defvar sql-builtin-face
909 (if sql-xemacs-p
910 ;; XEmacs doesn't have the builtin face
911 'font-lock-preprocessor-face
912 ;; GNU Emacs 19 doesn't either
913 (if sql-emacs19-p
914 'font-lock-keyword-face
915 ;; Emacs 2x
916 'font-lock-builtin-face))
917 "Builtin face for font-lock in SQL mode.")
918
919(defvar sql-doc-face
920 (if (or sql-xemacs-p
921 sql-emacs19-p
922 sql-emacs20-p)
923 'font-lock-string-face
924 'font-lock-doc-face)
925 "Documentation face for font-lock in SQL mode.")
926
927(defmacro sql-keywords-re (&rest keywords) 897(defmacro sql-keywords-re (&rest keywords)
928 "Compile-time generation of regexp matching any one of KEYWORDS." 898 "Compile-time generation of regexp matching any one of KEYWORDS."
929 `(eval-when-compile 899 `(eval-when-compile
@@ -1020,7 +990,7 @@ statement. The format of variable should be a valid
1020 990
1021 `((,ansi-non-reserved . font-lock-keyword-face) 991 `((,ansi-non-reserved . font-lock-keyword-face)
1022 (,ansi-reserved . font-lock-keyword-face) 992 (,ansi-reserved . font-lock-keyword-face)
1023 (,ansi-funcs . ,sql-builtin-face) 993 (,ansi-funcs . font-lock-builtin-face)
1024 (,ansi-types . font-lock-type-face))) 994 (,ansi-types . font-lock-type-face)))
1025 995
1026 "ANSI SQL keywords used by font-lock. 996 "ANSI SQL keywords used by font-lock.
@@ -1230,11 +1200,11 @@ add functions and PL/SQL keywords.")
1230 "\\b.*$" 1200 "\\b.*$"
1231 )))) 1201 ))))
1232 1202
1233 `((,sqlplus-commands . ,sql-doc-face) 1203 `((,sqlplus-commands . font-lock-doc-face)
1234 (,oracle-functions . ,sql-builtin-face) 1204 (,oracle-functions . font-lock-builtin-face)
1235 (,oracle-keywords . font-lock-keyword-face) 1205 (,oracle-keywords . font-lock-keyword-face)
1236 (,oracle-types . font-lock-type-face) 1206 (,oracle-types . font-lock-type-face)
1237 (,plsql-functions . ,sql-builtin-face) 1207 (,plsql-functions . font-lock-builtin-face)
1238 (,plsql-keywords . font-lock-keyword-face) 1208 (,plsql-keywords . font-lock-keyword-face)
1239 (,plsql-type . font-lock-type-face) 1209 (,plsql-type . font-lock-type-face)
1240 (,plsql-warning . font-lock-warning-face))) 1210 (,plsql-warning . font-lock-warning-face)))
@@ -1323,7 +1293,7 @@ to add functions and PL/SQL keywords.")
1323"timestamp" "varchar" "varying" "void" "zone" 1293"timestamp" "varchar" "varying" "void" "zone"
1324))) 1294)))
1325 1295
1326 `((,pg-funcs . ,sql-builtin-face) 1296 `((,pg-funcs . font-lock-builtin-face)
1327 (,pg-reserved . font-lock-keyword-face) 1297 (,pg-reserved . font-lock-keyword-face)
1328 (,pg-types . font-lock-type-face))) 1298 (,pg-types . font-lock-type-face)))
1329 1299
@@ -1404,7 +1374,7 @@ you define your own sql-mode-postgres-font-lock-keywords.")
1404 1374
1405 `((,linter-keywords . font-lock-keyword-face) 1375 `((,linter-keywords . font-lock-keyword-face)
1406 (,linter-reserved . font-lock-keyword-face) 1376 (,linter-reserved . font-lock-keyword-face)
1407 (,linter-functions . ,sql-builtin-face) 1377 (,linter-functions . font-lock-builtin-face)
1408 (,linter-types . font-lock-type-face))) 1378 (,linter-types . font-lock-type-face)))
1409 1379
1410 "Linter SQL keywords used by font-lock. 1380 "Linter SQL keywords used by font-lock.
@@ -1507,9 +1477,9 @@ function `regexp-opt'.")
1507) t) 1477) t)
1508 "\\)\\)\\|go\\s-*\\|use\\s-+\\|setuser\\s-+\\|dbcc\\s-+\\).*$")))) 1478 "\\)\\)\\|go\\s-*\\|use\\s-+\\|setuser\\s-+\\|dbcc\\s-+\\).*$"))))
1509 1479
1510 `((,ms-commands . ,sql-doc-face) 1480 `((,ms-commands . font-lock-doc-face)
1511 (,ms-reserved . font-lock-keyword-face) 1481 (,ms-reserved . font-lock-keyword-face)
1512 (,ms-functions . ,sql-builtin-face) 1482 (,ms-functions . font-lock-builtin-face)
1513 (,ms-vars . font-lock-variable-name-face) 1483 (,ms-vars . font-lock-variable-name-face)
1514 (,ms-types . font-lock-type-face))) 1484 (,ms-types . font-lock-type-face)))
1515 1485
@@ -1626,7 +1596,7 @@ you define your own sql-mode-solid-font-lock-keywords.")
1626"zerofill" 1596"zerofill"
1627))) 1597)))
1628 1598
1629 `((,mysql-funcs . ,sql-builtin-face) 1599 `((,mysql-funcs . font-lock-builtin-face)
1630 (,mysql-keywords . font-lock-keyword-face) 1600 (,mysql-keywords . font-lock-keyword-face)
1631 (,mysql-types . font-lock-type-face))) 1601 (,mysql-types . font-lock-type-face)))
1632 1602
@@ -1687,17 +1657,36 @@ the product-specific keywords and syntax-alists defined in
1687 ;; Get the product-specific keywords. 1657 ;; Get the product-specific keywords.
1688 (setq sql-mode-font-lock-keywords 1658 (setq sql-mode-font-lock-keywords
1689 (append 1659 (append
1690 (eval (sql-product-feature :font-lock)) 1660 (unless (eq sql-product 'ansi)
1661 (eval (sql-product-feature :font-lock)))
1662 ;; Always highlight ANSI keywords
1691 (eval (sql-product-feature :font-lock 'ansi)) 1663 (eval (sql-product-feature :font-lock 'ansi))
1664 ;; Fontify object names in CREATE, DROP and ALTER DDL
1665 ;; statements
1692 (list sql-mode-font-lock-object-name))) 1666 (list sql-mode-font-lock-object-name)))
1693 1667
1694 ;; Setup font-lock. (What is the minimum we should have to do 1668 ;; Setup font-lock. Force re-parsing of `font-lock-defaults'.
1695 ;; here?) 1669 (set (make-local-variable 'font-lock-set-defaults) nil)
1696 (setq font-lock-set-defaults nil 1670 (setq font-lock-defaults (list 'sql-mode-font-lock-keywords
1697 font-lock-keywords sql-mode-font-lock-keywords
1698 font-lock-defaults (list 'sql-mode-font-lock-keywords
1699 keywords-only t syntax-alist)) 1671 keywords-only t syntax-alist))
1700 1672
1673 ;; Force font lock to reinitialize if it is already on
1674 ;; Otherwise, we can wait until it can be started.
1675 (when (and (fboundp 'font-lock-mode)
1676 font-lock-mode)
1677 (font-lock-mode-internal nil)
1678 (font-lock-mode-internal t))
1679
1680 (add-hook 'font-lock-mode-hook
1681 (lambda ()
1682 ;; Provide defaults for new font-lock faces.
1683 (defvar font-lock-builtin-face
1684 (if (boundp 'font-lock-preprocessor-face)
1685 font-lock-preprocessor-face
1686 font-lock-keyword-face))
1687 (defvar font-lock-doc-face font-lock-string-face))
1688 nil t)
1689
1701 ;; Setup imenu; it needs the same syntax-alist. 1690 ;; Setup imenu; it needs the same syntax-alist.
1702 (when imenu 1691 (when imenu
1703 (setq imenu-syntax-alist syntax-alist)))) 1692 (setq imenu-syntax-alist syntax-alist))))
@@ -1744,11 +1733,6 @@ selected."
1744 ;; Setup font-lock 1733 ;; Setup font-lock
1745 (sql-product-font-lock nil t) 1734 (sql-product-font-lock nil t)
1746 1735
1747 ;; Force fontification, if its enabled.
1748 (if (and (boundp 'font-lock-mode)
1749 font-lock-mode)
1750 (font-lock-fontify-buffer))
1751
1752 ;; Set the mode name to include the product. 1736 ;; Set the mode name to include the product.
1753 (setq mode-name (concat "SQL[" (prin1-to-string sql-product) "]")))) 1737 (setq mode-name (concat "SQL[" (prin1-to-string sql-product) "]"))))
1754 1738
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
index e60eebe07cf..a7b32e8b264 100644
--- a/lisp/ps-print.el
+++ b/lisp/ps-print.el
@@ -3501,6 +3501,11 @@ The table depends on the current ps-print setup."
3501 #'ps-print-quote 3501 #'ps-print-quote
3502 (list 3502 (list
3503 (concat "\n;;; ps-print version " ps-print-version "\n") 3503 (concat "\n;;; ps-print version " ps-print-version "\n")
3504 ";; internal vars"
3505 (ps-comment-string "ps-print-emacs-type" ps-print-emacs-type)
3506 (ps-comment-string "ps-windows-system " ps-windows-system)
3507 (ps-comment-string "ps-lp-system " ps-lp-system)
3508 nil
3504 '(25 . ps-print-color-p) 3509 '(25 . ps-print-color-p)
3505 '(25 . ps-lpr-command) 3510 '(25 . ps-lpr-command)
3506 '(25 . ps-lpr-switches) 3511 '(25 . ps-lpr-switches)
@@ -3657,14 +3662,28 @@ If `ps-prefix-quote' is nil, it's set to t after generating string."
3657 (if (> col len) 3662 (if (> col len)
3658 (make-string (- col len) ?\ ) 3663 (make-string (- col len) ?\ )
3659 " ") 3664 " ")
3660 (cond ((null val) "nil") 3665 (ps-value-string val))))
3661 ((eq val t) "t")
3662 ((or (symbolp val) (listp val)) (format "'%S" val))
3663 (t (format "%S" val))))))
3664 (t "") 3666 (t "")
3665 )) 3667 ))
3666 3668
3667 3669
3670(defun ps-value-string (val)
3671 "Return a string representation of VAL. Used by `ps-print-quote'."
3672 (cond ((null val)
3673 "nil")
3674 ((eq val t)
3675 "t")
3676 ((or (symbolp val) (listp val))
3677 (format "'%S" val))
3678 (t
3679 (format "%S" val))))
3680
3681
3682(defun ps-comment-string (str value)
3683 "Return a comment string like \";; STR = VALUE\"."
3684 (format ";; %s = %s" str (ps-value-string value)))
3685
3686
3668(defun ps-value (alist-sym key) 3687(defun ps-value (alist-sym key)
3669 "Return value from association list ALIST-SYM which car is `eq' to KEY." 3688 "Return value from association list ALIST-SYM which car is `eq' to KEY."
3670 (cdr (assq key (symbol-value alist-sym)))) 3689 (cdr (assq key (symbol-value alist-sym))))
diff --git a/lisp/select.el b/lisp/select.el
index 01b227d8712..c095ea50c44 100644
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -176,47 +176,48 @@ Cut buffers are considered obsolete; you should use selections instead."
176 (if coding 176 (if coding
177 (setq coding (coding-system-base coding)) 177 (setq coding (coding-system-base coding))
178 (setq coding 'raw-text)) 178 (setq coding 'raw-text))
179 ;; Suppress producing escape sequences for compositions. 179 (let ((inhibit-read-only t))
180 (remove-text-properties 0 (length str) '(composition nil) str) 180 ;; Suppress producing escape sequences for compositions.
181 (cond 181 (remove-text-properties 0 (length str) '(composition nil) str)
182 ((eq type 'TEXT) 182 (cond
183 (if (not (multibyte-string-p str)) 183 ((eq type 'TEXT)
184 ;; Don't have to encode unibyte string. 184 (if (not (multibyte-string-p str))
185 (setq type 'STRING) 185 ;; Don't have to encode unibyte string.
186 ;; If STR contains only ASCII, Latin-1, and raw bytes, 186 (setq type 'STRING)
187 ;; encode STR by iso-latin-1, and return it as type 187 ;; If STR contains only ASCII, Latin-1, and raw bytes,
188 ;; `STRING'. Otherwise, encode STR by CODING. In that 188 ;; encode STR by iso-latin-1, and return it as type
189 ;; case, the returing type depends on CODING. 189 ;; `STRING'. Otherwise, encode STR by CODING. In that
190 (let ((charsets (find-charset-string str))) 190 ;; case, the returing type depends on CODING.
191 (setq charsets 191 (let ((charsets (find-charset-string str)))
192 (delq 'ascii 192 (setq charsets
193 (delq 'latin-iso8859-1 193 (delq 'ascii
194 (delq 'eight-bit-control 194 (delq 'latin-iso8859-1
195 (delq 'eight-bit-graphic charsets))))) 195 (delq 'eight-bit-control
196 (if charsets 196 (delq 'eight-bit-graphic charsets)))))
197 (setq str (encode-coding-string str coding) 197 (if charsets
198 type (if (memq coding '(compound-text 198 (setq str (encode-coding-string str coding)
199 compound-text-with-extensions)) 199 type (if (memq coding '(compound-text
200 'COMPOUND_TEXT 200 compound-text-with-extensions))
201 'STRING)) 201 'COMPOUND_TEXT
202 (setq type 'STRING 202 'STRING))
203 str (encode-coding-string str 'iso-latin-1)))))) 203 (setq type 'STRING
204 204 str (encode-coding-string str 'iso-latin-1))))))
205 ((eq type 'COMPOUND_TEXT) 205
206 (setq str (encode-coding-string str coding))) 206 ((eq type 'COMPOUND_TEXT)
207 207 (setq str (encode-coding-string str coding)))
208 ((eq type 'STRING) 208
209 (if (memq coding '(compound-text 209 ((eq type 'STRING)
210 compound-text-with-extensions)) 210 (if (memq coding '(compound-text
211 (setq str (string-make-unibyte str)) 211 compound-text-with-extensions))
212 (setq str (encode-coding-string str coding)))) 212 (setq str (string-make-unibyte str))
213 213 (setq str (encode-coding-string str coding))))
214 ((eq type 'UTF8_STRING) 214
215 (setq str (encode-coding-string str 'utf-8))) 215 ((eq type 'UTF8_STRING)
216 216 (setq str (encode-coding-string str 'utf-8)))
217 (t 217
218 (error "Unknow selection type: %S" type)) 218 (t
219 )) 219 (error "Unknow selection type: %S" type))
220 )))
220 221
221 (setq next-selection-coding-system nil) 222 (setq next-selection-coding-system nil)
222 (cons type str)))) 223 (cons type str))))
diff --git a/lisp/ses.el b/lisp/ses.el
index a5cc6bf657c..9439d98c481 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -983,7 +983,7 @@ be set to VALUE."
983 (ses-aset-with-undo (symbol-value def) elem value) 983 (ses-aset-with-undo (symbol-value def) elem value)
984 (ses-set-with-undo def value)) 984 (ses-set-with-undo def value))
985 (let ((inhibit-read-only t) 985 (let ((inhibit-read-only t)
986 (fmt (plist-get '(ses--column-widths "(ses-column-widths %S)" 986 (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)"
987 ses--col-printers "(ses-column-printers %S)" 987 ses--col-printers "(ses-column-printers %S)"
988 ses--default-printer "(ses-default-printer %S)" 988 ses--default-printer "(ses-default-printer %S)"
989 ses--header-row "(ses-header-row %S)" 989 ses--header-row "(ses-header-row %S)"
diff --git a/lisp/simple.el b/lisp/simple.el
index b557507fba1..fc6d64ae4a3 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -2401,8 +2401,7 @@ With prefix arg, kill that many lines starting from the current line.
2401If arg is negative, kill backward. Also kill the preceding newline. 2401If arg is negative, kill backward. Also kill the preceding newline.
2402\(This is meant to make C-x z work well with negative arguments.\) 2402\(This is meant to make C-x z work well with negative arguments.\)
2403If arg is zero, kill current line but exclude the trailing newline." 2403If arg is zero, kill current line but exclude the trailing newline."
2404 (interactive "P") 2404 (interactive "p")
2405 (setq arg (prefix-numeric-value arg))
2406 (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp))) 2405 (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp)))
2407 (signal 'end-of-buffer nil)) 2406 (signal 'end-of-buffer nil))
2408 (if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp))) 2407 (if (and (< arg 0) (bobp) (save-excursion (end-of-visible-line) (bobp)))
diff --git a/lisp/subr.el b/lisp/subr.el
index e81713ebf29..f90b5f774cb 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -90,7 +90,9 @@ DOCSTRING is an optional documentation string.
90 But documentation strings are usually not useful in nameless functions. 90 But documentation strings are usually not useful in nameless functions.
91INTERACTIVE should be a call to the function `interactive', which see. 91INTERACTIVE should be a call to the function `interactive', which see.
92It may also be omitted. 92It may also be omitted.
93BODY should be a list of Lisp expressions." 93BODY should be a list of Lisp expressions.
94
95\(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)"
94 ;; Note that this definition should not use backquotes; subr.el should not 96 ;; Note that this definition should not use backquotes; subr.el should not
95 ;; depend on backquote.el. 97 ;; depend on backquote.el.
96 (list 'function (cons 'lambda cdr))) 98 (list 'function (cons 'lambda cdr)))
@@ -161,7 +163,7 @@ the return value (nil if RESULT is omitted).
161(defmacro declare (&rest specs) 163(defmacro declare (&rest specs)
162 "Do not evaluate any arguments and return nil. 164 "Do not evaluate any arguments and return nil.
163Treated as a declaration when used at the right place in a 165Treated as a declaration when used at the right place in a
164`defmacro' form. \(See Info anchor `(elisp)Definition of declare'." 166`defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)"
165 nil) 167 nil)
166 168
167(defsubst caar (x) 169(defsubst caar (x)
@@ -180,34 +182,34 @@ Treated as a declaration when used at the right place in a
180 "Return the cdr of the cdr of X." 182 "Return the cdr of the cdr of X."
181 (cdr (cdr x))) 183 (cdr (cdr x)))
182 184
183(defun last (x &optional n) 185(defun last (list &optional n)
184 "Return the last link of the list X. Its car is the last element. 186 "Return the last link of LIST. Its car is the last element.
185If X is nil, return nil. 187If LIST is nil, return nil.
186If N is non-nil, return the Nth-to-last link of X. 188If N is non-nil, return the Nth-to-last link of LIST.
187If N is bigger than the length of X, return X." 189If N is bigger than the length of LIST, return LIST."
188 (if n 190 (if n
189 (let ((m 0) (p x)) 191 (let ((m 0) (p list))
190 (while (consp p) 192 (while (consp p)
191 (setq m (1+ m) p (cdr p))) 193 (setq m (1+ m) p (cdr p)))
192 (if (<= n 0) p 194 (if (<= n 0) p
193 (if (< n m) (nthcdr (- m n) x) x))) 195 (if (< n m) (nthcdr (- m n) list) list)))
194 (while (consp (cdr x)) 196 (while (consp (cdr list))
195 (setq x (cdr x))) 197 (setq list (cdr list)))
196 x)) 198 list))
197 199
198(defun butlast (x &optional n) 200(defun butlast (list &optional n)
199 "Returns a copy of LIST with the last N elements removed." 201 "Returns a copy of LIST with the last N elements removed."
200 (if (and n (<= n 0)) x 202 (if (and n (<= n 0)) list
201 (nbutlast (copy-sequence x) n))) 203 (nbutlast (copy-sequence list) n)))
202 204
203(defun nbutlast (x &optional n) 205(defun nbutlast (list &optional n)
204 "Modifies LIST to remove the last N elements." 206 "Modifies LIST to remove the last N elements."
205 (let ((m (length x))) 207 (let ((m (length list)))
206 (or n (setq n 1)) 208 (or n (setq n 1))
207 (and (< n m) 209 (and (< n m)
208 (progn 210 (progn
209 (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) 211 (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
210 x)))) 212 list))))
211 213
212(defun delete-dups (list) 214(defun delete-dups (list)
213 "Destructively remove `equal' duplicates from LIST. 215 "Destructively remove `equal' duplicates from LIST.
@@ -1114,6 +1116,7 @@ FILE should be the name of a library, with no directory name."
1114 "Open a TCP connection for a service to a host. 1116 "Open a TCP connection for a service to a host.
1115Returns a subprocess-object to represent the connection. 1117Returns a subprocess-object to represent the connection.
1116Input and output work as for subprocesses; `delete-process' closes it. 1118Input and output work as for subprocesses; `delete-process' closes it.
1119
1117Args are NAME BUFFER HOST SERVICE. 1120Args are NAME BUFFER HOST SERVICE.
1118NAME is name for process. It is modified if necessary to make it unique. 1121NAME is name for process. It is modified if necessary to make it unique.
1119BUFFER is the buffer (or buffer-name) to associate with the process. 1122BUFFER is the buffer (or buffer-name) to associate with the process.
@@ -1178,12 +1181,13 @@ does not use these function."
1178 1181
1179;; compatibility 1182;; compatibility
1180 1183
1184(make-obsolete 'process-kill-without-query
1185 "use `process-query-on-exit-flag'\nor `set-process-query-on-exit-flag'."
1186 "21.5")
1181(defun process-kill-without-query (process &optional flag) 1187(defun process-kill-without-query (process &optional flag)
1182 "Say no query needed if PROCESS is running when Emacs is exited. 1188 "Say no query needed if PROCESS is running when Emacs is exited.
1183Optional second argument if non-nil says to require a query. 1189Optional second argument if non-nil says to require a query.
1184Value is t if a query was formerly required. 1190Value is t if a query was formerly required."
1185New code should not use this function; use `process-query-on-exit-flag'
1186or `set-process-query-on-exit-flag' instead."
1187 (let ((old (process-query-on-exit-flag process))) 1191 (let ((old (process-query-on-exit-flag process)))
1188 (set-process-query-on-exit-flag process nil) 1192 (set-process-query-on-exit-flag process nil)
1189 old)) 1193 old))
@@ -1693,26 +1697,27 @@ If UNDO is present and non-nil, it is a function that will be called
1693 (if (nth 4 handler) ;; COMMAND 1697 (if (nth 4 handler) ;; COMMAND
1694 (setq this-command (nth 4 handler))))) 1698 (setq this-command (nth 4 handler)))))
1695 1699
1696(defun insert-buffer-substring-no-properties (buf &optional start end) 1700(defun insert-buffer-substring-no-properties (buffer &optional start end)
1697 "Insert before point a substring of buffer BUFFER, without text properties. 1701 "Insert before point a substring of BUFFER, without text properties.
1698BUFFER may be a buffer or a buffer name. 1702BUFFER may be a buffer or a buffer name.
1699Arguments START and END are character numbers specifying the substring. 1703Arguments START and END are character numbers specifying the substring.
1700They default to the beginning and the end of BUFFER." 1704They default to the beginning and the end of BUFFER."
1701 (let ((opoint (point))) 1705 (let ((opoint (point)))
1702 (insert-buffer-substring buf start end) 1706 (insert-buffer-substring buffer start end)
1703 (let ((inhibit-read-only t)) 1707 (let ((inhibit-read-only t))
1704 (set-text-properties opoint (point) nil)))) 1708 (set-text-properties opoint (point) nil))))
1705 1709
1706(defun insert-buffer-substring-as-yank (buf &optional start end) 1710(defun insert-buffer-substring-as-yank (buffer &optional start end)
1707 "Insert before point a part of buffer BUFFER, stripping some text properties. 1711 "Insert before point a part of BUFFER, stripping some text properties.
1708BUFFER may be a buffer or a buffer name. Arguments START and END are 1712BUFFER may be a buffer or a buffer name.
1709character numbers specifying the substring. They default to the 1713Arguments START and END are character numbers specifying the substring.
1710beginning and the end of BUFFER. Strip text properties from the 1714They default to the beginning and the end of BUFFER.
1711inserted text according to `yank-excluded-properties'." 1715Strip text properties from the inserted text according to
1716`yank-excluded-properties'."
1712 ;; Since the buffer text should not normally have yank-handler properties, 1717 ;; Since the buffer text should not normally have yank-handler properties,
1713 ;; there is no need to handle them here. 1718 ;; there is no need to handle them here.
1714 (let ((opoint (point))) 1719 (let ((opoint (point)))
1715 (insert-buffer-substring buf start end) 1720 (insert-buffer-substring buffer start end)
1716 (remove-yank-excluded-properties opoint (point)))) 1721 (remove-yank-excluded-properties opoint (point))))
1717 1722
1718 1723
@@ -2073,7 +2078,7 @@ which separates, but is not part of, the substrings. If nil it defaults to
2073`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and 2078`split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and
2074OMIT-NULLS is forced to t. 2079OMIT-NULLS is forced to t.
2075 2080
2076If OMIT-NULLs is t, zero-length substrings are omitted from the list \(so 2081If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so
2077that for the default value of SEPARATORS leading and trailing whitespace 2082that for the default value of SEPARATORS leading and trailing whitespace
2078are effectively trimmed). If nil, all zero-length substrings are retained, 2083are effectively trimmed). If nil, all zero-length substrings are retained,
2079which correctly parses CSV format, for example. 2084which correctly parses CSV format, for example.
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
index f43d8b235d1..1ffab849406 100644
--- a/lisp/term/w32-win.el
+++ b/lisp/term/w32-win.el
@@ -76,6 +76,7 @@
76(require 'faces) 76(require 'faces)
77(require 'select) 77(require 'select)
78(require 'menu-bar) 78(require 'menu-bar)
79(require 'x-dnd)
79;; Conditional on new-fontset so bootstrapping works on non-GUI compiles 80;; Conditional on new-fontset so bootstrapping works on non-GUI compiles
80(if (fboundp 'new-fontset) 81(if (fboundp 'new-fontset)
81 (require 'fontset)) 82 (require 'fontset))
@@ -105,7 +106,10 @@ Switch to a buffer editing the last file dropped."
105 (y (cdr coords))) 106 (y (cdr coords)))
106 (if (and (> x 0) (> y 0)) 107 (if (and (> x 0) (> y 0))
107 (set-frame-selected-window nil window)) 108 (set-frame-selected-window nil window))
108 (mapcar 'find-file (car (cdr (cdr event))))) 109 (mapcar (lambda (file-name)
110 (x-dnd-handle-one-url window 'private
111 (concat "file:" file-name)))
112 (car (cdr (cdr event)))))
109 (raise-frame))) 113 (raise-frame)))
110 114
111(defun w32-drag-n-drop-other-frame (event) 115(defun w32-drag-n-drop-other-frame (event)
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
index cd26352a962..381ee606300 100644
--- a/lisp/term/x-win.el
+++ b/lisp/term/x-win.el
@@ -2334,7 +2334,10 @@ order until succeed.")
2334(defun x-clipboard-yank () 2334(defun x-clipboard-yank ()
2335 "Insert the clipboard contents, or the last stretch of killed text." 2335 "Insert the clipboard contents, or the last stretch of killed text."
2336 (interactive) 2336 (interactive)
2337 (let ((clipboard-text (x-get-selection 'CLIPBOARD)) 2337 (let ((clipboard-text
2338 (condition-case nil
2339 (x-get-selection 'CLIPBOARD)
2340 (error nil)))
2338 (x-select-enable-clipboard t)) 2341 (x-select-enable-clipboard t))
2339 (if (and clipboard-text (> (length clipboard-text) 0)) 2342 (if (and clipboard-text (> (length clipboard-text) 0))
2340 (kill-new clipboard-text)) 2343 (kill-new clipboard-text))
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
index 82b15cf4eb5..5c95b138720 100644
--- a/lisp/textmodes/bibtex.el
+++ b/lisp/textmodes/bibtex.el
@@ -1,6 +1,7 @@
1;;; bibtex.el --- BibTeX mode for GNU Emacs 1;;; bibtex.el --- BibTeX mode for GNU Emacs
2 2
3;; Copyright (C) 1992,94,95,96,97,98,1999,2003 Free Software Foundation, Inc. 3;; Copyright (C) 1992,94,95,96,97,98,1999,2003,2004
4;; Free Software Foundation, Inc.
4 5
5;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de> 6;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
6;; Bengt Martensson <bengt@mathematik.uni-Bremen.de> 7;; Bengt Martensson <bengt@mathematik.uni-Bremen.de>
@@ -811,6 +812,7 @@ If non-nil, the column for the equal sign is the value of
811 (define-key km "\C-c\M-y" 'bibtex-yank-pop) 812 (define-key km "\C-c\M-y" 'bibtex-yank-pop)
812 (define-key km "\C-c\C-d" 'bibtex-empty-field) 813 (define-key km "\C-c\C-d" 'bibtex-empty-field)
813 (define-key km "\C-c\C-f" 'bibtex-make-field) 814 (define-key km "\C-c\C-f" 'bibtex-make-field)
815 (define-key km "\C-c\C-u" 'bibtex-entry-update)
814 (define-key km "\C-c$" 'bibtex-ispell-abstract) 816 (define-key km "\C-c$" 'bibtex-ispell-abstract)
815 (define-key km "\M-\C-a" 'bibtex-beginning-of-entry) 817 (define-key km "\M-\C-a" 'bibtex-beginning-of-entry)
816 (define-key km "\M-\C-e" 'bibtex-end-of-entry) 818 (define-key km "\M-\C-e" 'bibtex-end-of-entry)
@@ -1122,44 +1124,6 @@ function `bibtex-parse-field-name'.")
1122 '(bibtex-mode "@\\S(*\\s(" "\\s)" nil bibtex-hs-forward-sexp nil)) 1124 '(bibtex-mode "@\\S(*\\s(" "\\s)" nil bibtex-hs-forward-sexp nil))
1123 1125
1124 1126
1125(defconst bibtex-braced-string-syntax-table
1126 (let ((st (make-syntax-table)))
1127 (modify-syntax-entry ?\{ "(}" st)
1128 (modify-syntax-entry ?\} "){" st)
1129 (modify-syntax-entry ?\[ "." st)
1130 (modify-syntax-entry ?\] "." st)
1131 (modify-syntax-entry ?\( "." st)
1132 (modify-syntax-entry ?\) "." st)
1133 (modify-syntax-entry ?\\ "." st)
1134 (modify-syntax-entry ?\" "." st)
1135 st)
1136 "Syntax-table to parse matched braces.")
1137
1138(defconst bibtex-quoted-string-syntax-table
1139 (let ((st (make-syntax-table)))
1140 (modify-syntax-entry ?\\ "\\" st)
1141 (modify-syntax-entry ?\" "\"" st)
1142 st)
1143 "Syntax-table to parse matched quotes.")
1144
1145(defun bibtex-parse-field-string ()
1146 "Parse a field string enclosed by braces or quotes.
1147If a syntactically correct string is found, a pair containing the start and
1148end position of the field string is returned, nil otherwise."
1149 (let ((end-point
1150 (or (and (eq (following-char) ?\")
1151 (save-excursion
1152 (with-syntax-table bibtex-quoted-string-syntax-table
1153 (forward-sexp 1))
1154 (point)))
1155 (and (eq (following-char) ?\{)
1156 (save-excursion
1157 (with-syntax-table bibtex-braced-string-syntax-table
1158 (forward-sexp 1))
1159 (point))))))
1160 (if end-point
1161 (cons (point) end-point))))
1162
1163(defun bibtex-parse-association (parse-lhs parse-rhs) 1127(defun bibtex-parse-association (parse-lhs parse-rhs)
1164 "Parse a string of the format <left-hand-side = right-hand-side>. 1128 "Parse a string of the format <left-hand-side = right-hand-side>.
1165The functions PARSE-LHS and PARSE-RHS are used to parse the corresponding 1129The functions PARSE-LHS and PARSE-RHS are used to parse the corresponding
@@ -1199,6 +1163,44 @@ BibTeX field as necessary."
1199 ;; Now try again. 1163 ;; Now try again.
1200 (bibtex-parse-field-name)))) 1164 (bibtex-parse-field-name))))
1201 1165
1166(defconst bibtex-braced-string-syntax-table
1167 (let ((st (make-syntax-table)))
1168 (modify-syntax-entry ?\{ "(}" st)
1169 (modify-syntax-entry ?\} "){" st)
1170 (modify-syntax-entry ?\[ "." st)
1171 (modify-syntax-entry ?\] "." st)
1172 (modify-syntax-entry ?\( "." st)
1173 (modify-syntax-entry ?\) "." st)
1174 (modify-syntax-entry ?\\ "." st)
1175 (modify-syntax-entry ?\" "." st)
1176 st)
1177 "Syntax-table to parse matched braces.")
1178
1179(defconst bibtex-quoted-string-syntax-table
1180 (let ((st (make-syntax-table)))
1181 (modify-syntax-entry ?\\ "\\" st)
1182 (modify-syntax-entry ?\" "\"" st)
1183 st)
1184 "Syntax-table to parse matched quotes.")
1185
1186(defun bibtex-parse-field-string ()
1187 "Parse a field string enclosed by braces or quotes.
1188If a syntactically correct string is found, a pair containing the start and
1189end position of the field string is returned, nil otherwise."
1190 (let ((end-point
1191 (or (and (eq (following-char) ?\")
1192 (save-excursion
1193 (with-syntax-table bibtex-quoted-string-syntax-table
1194 (forward-sexp 1))
1195 (point)))
1196 (and (eq (following-char) ?\{)
1197 (save-excursion
1198 (with-syntax-table bibtex-braced-string-syntax-table
1199 (forward-sexp 1))
1200 (point))))))
1201 (if end-point
1202 (cons (point) end-point))))
1203
1202(defun bibtex-parse-field-text () 1204(defun bibtex-parse-field-text ()
1203 "Parse the text part of a BibTeX field. 1205 "Parse the text part of a BibTeX field.
1204The text part is either a string, or an empty string, or a constant followed 1206The text part is either a string, or an empty string, or a constant followed
@@ -1410,7 +1412,7 @@ delimiters if present."
1410 (let ((content (buffer-substring-no-properties (nth 0 (cdr bounds)) 1412 (let ((content (buffer-substring-no-properties (nth 0 (cdr bounds))
1411 (nth 1 (cdr bounds))))) 1413 (nth 1 (cdr bounds)))))
1412 (if (and remove-delim 1414 (if (and remove-delim
1413 (string-match "\\`{\\(.*\\)}\\'" content)) 1415 (string-match "\\`[{\"]\\(.*\\)[}\"]\\'" content))
1414 (substring content (match-beginning 1) (match-end 1)) 1416 (substring content (match-beginning 1) (match-end 1))
1415 content))) 1417 content)))
1416 1418
@@ -1455,16 +1457,6 @@ The value is actually the tail of LIST whose car matches STRING."
1455 (setq list (cdr list))) 1457 (setq list (cdr list)))
1456 list)) 1458 list))
1457 1459
1458(defun bibtex-assoc-of-regexp (string alist)
1459 "Return non-nil if STRING is exactly matched by the car of an
1460element of ALIST (case ignored). The value is actually the element
1461of LIST whose car matches STRING."
1462 (let ((case-fold-search t))
1463 (while (and alist
1464 (not (string-match (concat "\\`\\(?:" (caar alist) "\\)\\'") string)))
1465 (setq alist (cdr alist)))
1466 (car alist)))
1467
1468(defun bibtex-skip-to-valid-entry (&optional backward) 1460(defun bibtex-skip-to-valid-entry (&optional backward)
1469 "Unless at beginning of a valid BibTeX entry, move point to beginning of the 1461 "Unless at beginning of a valid BibTeX entry, move point to beginning of the
1470next valid one. With optional argument BACKWARD non-nil, move backward to 1462next valid one. With optional argument BACKWARD non-nil, move backward to
@@ -1519,8 +1511,8 @@ FUN will not be called for @String entries."
1519If FLAG is a string, the message is initialized (in this case a 1511If FLAG is a string, the message is initialized (in this case a
1520value for INTERVAL may be given as well (if not this is set to 5)). 1512value for INTERVAL may be given as well (if not this is set to 5)).
1521If FLAG is done, the message is deinitialized. 1513If FLAG is done, the message is deinitialized.
1522If FLAG is absent, a message is echoed if point was incremented 1514If FLAG is nil, a message is echoed if point was incremented at least
1523at least INTERVAL percent since last message was echoed." 1515`bibtex-progress-interval' percent since last message was echoed."
1524 (cond ((stringp flag) 1516 (cond ((stringp flag)
1525 (setq bibtex-progress-lastmes flag) 1517 (setq bibtex-progress-lastmes flag)
1526 (setq bibtex-progress-interval (or interval 5) 1518 (setq bibtex-progress-interval (or interval 5)
@@ -1685,11 +1677,11 @@ are defined, but only for the head part of the entry
1685 "Try to avoid point being at end of a BibTeX field." 1677 "Try to avoid point being at end of a BibTeX field."
1686 (end-of-line) 1678 (end-of-line)
1687 (skip-chars-backward " \t") 1679 (skip-chars-backward " \t")
1688 (cond ((= (preceding-char) ?,) 1680 (if (= (preceding-char) ?,)
1689 (forward-char -2))) 1681 (forward-char -2))
1690 (cond ((or (= (preceding-char) ?}) 1682 (if (or (= (preceding-char) ?})
1691 (= (preceding-char) ?\")) 1683 (= (preceding-char) ?\"))
1692 (forward-char -1)))) 1684 (forward-char -1)))
1693 1685
1694(defun bibtex-enclosing-field (&optional noerr) 1686(defun bibtex-enclosing-field (&optional noerr)
1695 "Search for BibTeX field enclosing point. Point moves to end of field. 1687 "Search for BibTeX field enclosing point. Point moves to end of field.
@@ -1749,6 +1741,15 @@ Beginning (but not end) of entry is given by (`match-beginning' 0)."
1749 (error "Unknown tag field: %s. Please submit a bug report" 1741 (error "Unknown tag field: %s. Please submit a bug report"
1750 bibtex-last-kill-command)))))) 1742 bibtex-last-kill-command))))))
1751 1743
1744(defun bibtex-assoc-regexp (regexp alist)
1745 "Return non-nil if REGEXP matches the car of an element of ALIST.
1746The value is actually the element of ALIST matched by REGEXP.
1747Case is ignored if `case-fold-search' is non-nil in the current buffer."
1748 (while (and alist
1749 (not (string-match regexp (caar alist))))
1750 (setq alist (cdr alist)))
1751 (car alist))
1752
1752(defun bibtex-format-entry () 1753(defun bibtex-format-entry ()
1753 "Helper function for `bibtex-clean-entry'. 1754 "Helper function for `bibtex-clean-entry'.
1754Formats current entry according to variable `bibtex-entry-format'." 1755Formats current entry according to variable `bibtex-entry-format'."
@@ -1763,7 +1764,7 @@ Formats current entry according to variable `bibtex-entry-format'."
1763 unify-case inherit-booktitle) 1764 unify-case inherit-booktitle)
1764 bibtex-entry-format)) 1765 bibtex-entry-format))
1765 crossref-key bounds alternatives-there non-empty-alternative 1766 crossref-key bounds alternatives-there non-empty-alternative
1766 entry-list req creq field-done field-list) 1767 entry-list req-field-list field-done field-list)
1767 1768
1768 ;; identify entry type 1769 ;; identify entry type
1769 (goto-char (point-min)) 1770 (goto-char (point-min))
@@ -1772,9 +1773,7 @@ Formats current entry according to variable `bibtex-entry-format'."
1772 (end-type (match-end 0))) 1773 (end-type (match-end 0)))
1773 (setq entry-list (assoc-ignore-case (buffer-substring-no-properties 1774 (setq entry-list (assoc-ignore-case (buffer-substring-no-properties
1774 beg-type end-type) 1775 beg-type end-type)
1775 bibtex-entry-field-alist) 1776 bibtex-entry-field-alist))
1776 req (nth 0 (nth 1 entry-list)) ; required part
1777 creq (nth 0 (nth 2 entry-list))) ; crossref part
1778 1777
1779 ;; unify case of entry name 1778 ;; unify case of entry name
1780 (when (memq 'unify-case format) 1779 (when (memq 'unify-case format)
@@ -1791,20 +1790,32 @@ Formats current entry according to variable `bibtex-entry-format'."
1791 ;; determine if entry has crossref field and if at least 1790 ;; determine if entry has crossref field and if at least
1792 ;; one alternative is non-empty 1791 ;; one alternative is non-empty
1793 (goto-char (point-min)) 1792 (goto-char (point-min))
1794 (while (setq bounds (bibtex-search-forward-field 1793 (let* ((fields-alist (bibtex-parse-entry))
1795 bibtex-field-name)) 1794 (case-fold-search t)
1796 (goto-char (bibtex-start-of-name-in-field bounds)) 1795 (field (bibtex-assoc-regexp "\\(OPT\\)?crossref\\>"
1797 (cond ((looking-at "ALT") 1796 fields-alist)))
1798 (setq alternatives-there t) 1797 (setq crossref-key (and field
1799 (goto-char (bibtex-start-of-text-in-field bounds)) 1798 (not (string-match bibtex-empty-field-re
1800 (if (not (looking-at bibtex-empty-field-re)) 1799 (cdr field)))
1801 (setq non-empty-alternative t))) 1800 (cdr field))
1802 ((and (looking-at "\\(OPT\\)?crossref\\>") 1801 req-field-list (if crossref-key
1803 (progn (goto-char (bibtex-start-of-text-in-field bounds)) 1802 (nth 0 (nth 2 entry-list)) ; crossref part
1804 (not (looking-at bibtex-empty-field-re)))) 1803 (nth 0 (nth 1 entry-list)))) ; required part
1805 (setq crossref-key 1804
1806 (bibtex-text-in-field-bounds bounds t)))) 1805 (dolist (rfield req-field-list)
1807 (goto-char (bibtex-end-of-field bounds))) 1806 (when (nth 3 rfield) ; we should have an alternative
1807 (setq alternatives-there t
1808 field (bibtex-assoc-regexp
1809 (concat "\\(ALT\\)?" (car rfield) "\\>")
1810 fields-alist))
1811 (if (and field
1812 (not (string-match bibtex-empty-field-re
1813 (cdr field))))
1814 (cond ((not non-empty-alternative)
1815 (setq non-empty-alternative t))
1816 ((memq 'required-fields format)
1817 (error "More than one non-empty alternative.")))))))
1818
1808 (if (and alternatives-there 1819 (if (and alternatives-there
1809 (not non-empty-alternative) 1820 (not non-empty-alternative)
1810 (memq 'required-fields format)) 1821 (memq 'required-fields format))
@@ -1832,18 +1843,23 @@ Formats current entry according to variable `bibtex-entry-format'."
1832 ;; quite some redundancy compared with what we need to do 1843 ;; quite some redundancy compared with what we need to do
1833 ;; anyway. So for speed-up we avoid using them. 1844 ;; anyway. So for speed-up we avoid using them.
1834 1845
1835 (when (and opt-alt 1846 (if (memq 'opts-or-alts format)
1836 (memq 'opts-or-alts format)) 1847 (cond ((and empty-field
1837 (if empty-field 1848 (or opt-alt
1838 ;; Either it is an empty ALT field. Then we have checked 1849 (let ((field (assoc-ignore-case
1839 ;; already that we have one non-empty alternative. 1850 field-name req-field-list)))
1840 ;; Or it is an empty OPT field that we do not miss anyway. 1851 (or (not field) ; OPT field
1841 ;; So we can safely delete this field. 1852 (nth 3 field))))) ; ALT field
1842 (progn (delete-region beg-field end-field) 1853 ;; Either it is an empty ALT field. Then we have checked
1843 (setq deleted t)) 1854 ;; already that we have one non-empty alternative. Or it
1844 ;; otherwise: not empty, delete "OPT" or "ALT" 1855 ;; is an empty OPT field that we do not miss anyway.
1845 (goto-char beg-name) 1856 ;; So we can safely delete this field.
1846 (delete-char 3))) 1857 (delete-region beg-field end-field)
1858 (setq deleted t))
1859 ;; otherwise: not empty, delete "OPT" or "ALT"
1860 (opt-alt
1861 (goto-char beg-name)
1862 (delete-char 3))))
1847 1863
1848 (unless deleted 1864 (unless deleted
1849 (push field-name field-list) 1865 (push field-name field-list)
@@ -1902,8 +1918,7 @@ Formats current entry according to variable `bibtex-entry-format'."
1902 ;; if empty field, complain 1918 ;; if empty field, complain
1903 (if (and empty-field 1919 (if (and empty-field
1904 (memq 'required-fields format) 1920 (memq 'required-fields format)
1905 (assoc-ignore-case field-name 1921 (assoc-ignore-case field-name req-field-list))
1906 (if crossref-key creq req)))
1907 (error "Mandatory field `%s' is empty" field-name)) 1922 (error "Mandatory field `%s' is empty" field-name))
1908 1923
1909 ;; unify case of field name 1924 ;; unify case of field name
@@ -1925,8 +1940,8 @@ Formats current entry according to variable `bibtex-entry-format'."
1925 1940
1926 ;; check whether all required fields are present 1941 ;; check whether all required fields are present
1927 (if (memq 'required-fields format) 1942 (if (memq 'required-fields format)
1928 (let (altlist (found 0)) 1943 (let ((found 0) altlist)
1929 (dolist (fname (if crossref-key creq req)) 1944 (dolist (fname req-field-list)
1930 (if (nth 3 fname) 1945 (if (nth 3 fname)
1931 (push (car fname) altlist)) 1946 (push (car fname) altlist))
1932 (unless (or (member (car fname) field-list) 1947 (unless (or (member (car fname) field-list)
@@ -1940,7 +1955,7 @@ Formats current entry according to variable `bibtex-entry-format'."
1940 (error "Alternative mandatory field `%s' is missing" 1955 (error "Alternative mandatory field `%s' is missing"
1941 altlist)) 1956 altlist))
1942 ((> found 1) 1957 ((> found 1)
1943 (error "Alternative fields `%s' is defined %s times" 1958 (error "Alternative fields `%s' are defined %s times"
1944 altlist found)))))) 1959 altlist found))))))
1945 1960
1946 ;; update point 1961 ;; update point
@@ -2051,8 +2066,8 @@ and return results as a list."
2051 (setq titlestring (substring titlestring 0 (match-beginning 0)))))) 2066 (setq titlestring (substring titlestring 0 (match-beginning 0))))))
2052 ;; gather words from titlestring into a list. Ignore 2067 ;; gather words from titlestring into a list. Ignore
2053 ;; specific words and use only a specific amount of words. 2068 ;; specific words and use only a specific amount of words.
2054 (let (case-fold-search titlewords titlewords-extra titleword end-match 2069 (let ((counter 0)
2055 (counter 0)) 2070 case-fold-search titlewords titlewords-extra titleword end-match)
2056 (while (and (or (not (numberp bibtex-autokey-titlewords)) 2071 (while (and (or (not (numberp bibtex-autokey-titlewords))
2057 (< counter (+ bibtex-autokey-titlewords 2072 (< counter (+ bibtex-autokey-titlewords
2058 bibtex-autokey-titlewords-stretch))) 2073 bibtex-autokey-titlewords-stretch)))
@@ -2079,10 +2094,14 @@ and return results as a list."
2079 "Do some abbreviations on TITLEWORD. 2094 "Do some abbreviations on TITLEWORD.
2080The rules are defined in `bibtex-autokey-titleword-abbrevs' 2095The rules are defined in `bibtex-autokey-titleword-abbrevs'
2081and `bibtex-autokey-titleword-length'." 2096and `bibtex-autokey-titleword-length'."
2082 (let ((abbrev (bibtex-assoc-of-regexp 2097 (let ((case-folde-search t)
2083 titleword bibtex-autokey-titleword-abbrevs))) 2098 (alist bibtex-autokey-titleword-abbrevs))
2084 (if abbrev 2099 (while (and alist
2085 (cdr abbrev) 2100 (not (string-match (concat "\\`\\(?:" (caar alist) "\\)\\'")
2101 titleword)))
2102 (setq alist (cdr alist)))
2103 (if alist
2104 (cdar alist)
2086 (bibtex-autokey-abbrev titleword 2105 (bibtex-autokey-abbrev titleword
2087 bibtex-autokey-titleword-length)))) 2106 bibtex-autokey-titleword-length))))
2088 2107
@@ -2384,6 +2403,7 @@ of a word, all strings are listed. Return completion."
2384 (display-completion-list (all-completions part-of-word 2403 (display-completion-list (all-completions part-of-word
2385 completions))) 2404 completions)))
2386 (message "Making completion list...done") 2405 (message "Making completion list...done")
2406 ;; return value is handled by choose-completion-string-functions
2387 nil)))) 2407 nil))))
2388 2408
2389(defun bibtex-complete-string-cleanup (str) 2409(defun bibtex-complete-string-cleanup (str)
@@ -2629,6 +2649,34 @@ non-nil.
2629 (easy-menu-add bibtex-entry-menu) 2649 (easy-menu-add bibtex-entry-menu)
2630 (run-hooks 'bibtex-mode-hook)) 2650 (run-hooks 'bibtex-mode-hook))
2631 2651
2652(defun bibtex-field-list (entry-type)
2653 "Return list of allowed fields for entry ENTRY-TYPE.
2654More specifically, the return value is a cons pair (REQUIRED . OPTIONAL),
2655where REQUIRED and OPTIONAL are lists of the required and optional field
2656names for ENTRY-TYPE according to `bibtex-entry-field-alist'."
2657 (let ((e (assoc-ignore-case entry-type bibtex-entry-field-alist))
2658 required optional)
2659 (unless e
2660 (error "Bibtex entry type %s not defined" entry-type))
2661 (if (and (member-ignore-case entry-type bibtex-include-OPTcrossref)
2662 (nth 2 e))
2663 (setq required (nth 0 (nth 2 e))
2664 optional (nth 1 (nth 2 e)))
2665 (setq required (nth 0 (nth 1 e))
2666 optional (nth 1 (nth 1 e))))
2667 (if bibtex-include-OPTkey
2668 (push (list "key"
2669 "Used for reference key creation if author and editor fields are missing"
2670 (if (or (stringp bibtex-include-OPTkey)
2671 (fboundp bibtex-include-OPTkey))
2672 bibtex-include-OPTkey))
2673 optional))
2674 (if (member-ignore-case entry-type bibtex-include-OPTcrossref)
2675 (push '("crossref" "Reference key of the cross-referenced entry")
2676 optional))
2677 (setq optional (append optional bibtex-user-optional-fields))
2678 (cons required optional)))
2679
2632(defun bibtex-entry (entry-type) 2680(defun bibtex-entry (entry-type)
2633 "Insert a new BibTeX entry. 2681 "Insert a new BibTeX entry.
2634After insertion it calls the functions in `bibtex-add-entry-hook'." 2682After insertion it calls the functions in `bibtex-add-entry-hook'."
@@ -2638,38 +2686,17 @@ After insertion it calls the functions in `bibtex-add-entry-hook'."
2638 bibtex-entry-field-alist 2686 bibtex-entry-field-alist
2639 nil t nil 'bibtex-entry-type-history))) 2687 nil t nil 'bibtex-entry-type-history)))
2640 (list e-t))) 2688 (list e-t)))
2641 (let* (required optional 2689 (let ((key (if bibtex-maintain-sorted-entries
2642 (key (if bibtex-maintain-sorted-entries 2690 (bibtex-read-key (format "%s key: " entry-type))))
2643 (bibtex-read-key (format "%s key: " entry-type)))) 2691 (field-list (bibtex-field-list entry-type)))
2644 (e (assoc-ignore-case entry-type bibtex-entry-field-alist))
2645 (r-n-o (elt e 1))
2646 (c-ref (elt e 2)))
2647 (if (not e)
2648 (error "Bibtex entry type %s not defined" entry-type))
2649 (if (and (member entry-type bibtex-include-OPTcrossref)
2650 c-ref)
2651 (setq required (elt c-ref 0)
2652 optional (elt c-ref 1))
2653 (setq required (elt r-n-o 0)
2654 optional (elt r-n-o 1)))
2655 (unless (bibtex-prepare-new-entry (list key nil entry-type)) 2692 (unless (bibtex-prepare-new-entry (list key nil entry-type))
2656 (error "Entry with key `%s' already exists" key)) 2693 (error "Entry with key `%s' already exists" key))
2657 (indent-to-column bibtex-entry-offset) 2694 (indent-to-column bibtex-entry-offset)
2658 (insert "@" entry-type (bibtex-entry-left-delimiter)) 2695 (insert "@" entry-type (bibtex-entry-left-delimiter))
2659 (if key 2696 (if key (insert key))
2660 (insert key))
2661 (save-excursion 2697 (save-excursion
2662 (mapcar 'bibtex-make-field required) 2698 (mapcar 'bibtex-make-field (car field-list))
2663 (if (member entry-type bibtex-include-OPTcrossref) 2699 (mapcar 'bibtex-make-optional-field (cdr field-list))
2664 (bibtex-make-optional-field '("crossref")))
2665 (if bibtex-include-OPTkey
2666 (if (or (stringp bibtex-include-OPTkey)
2667 (fboundp bibtex-include-OPTkey))
2668 (bibtex-make-optional-field
2669 (list "key" nil bibtex-include-OPTkey))
2670 (bibtex-make-optional-field '("key"))))
2671 (mapcar 'bibtex-make-optional-field optional)
2672 (mapcar 'bibtex-make-optional-field bibtex-user-optional-fields)
2673 (if bibtex-comma-after-last-field 2700 (if bibtex-comma-after-last-field
2674 (insert ",")) 2701 (insert ","))
2675 (insert "\n") 2702 (insert "\n")
@@ -2680,10 +2707,31 @@ After insertion it calls the functions in `bibtex-add-entry-hook'."
2680 (bibtex-autofill-entry)) 2707 (bibtex-autofill-entry))
2681 (run-hooks 'bibtex-add-entry-hook))) 2708 (run-hooks 'bibtex-add-entry-hook)))
2682 2709
2710(defun bibtex-entry-update ()
2711 "Update an existing BibTeX entry.
2712In the BibTeX entry at point, make new fields for those items that may occur
2713according to `bibtex-entry-field-alist', but are not yet present."
2714 (interactive)
2715 (save-excursion
2716 (bibtex-beginning-of-entry)
2717 ;; For inserting new fields, we use the fact that
2718 ;; bibtex-parse-entry moves point to the end of the last field.
2719 (let* ((fields-alist (bibtex-parse-entry))
2720 (field-list (bibtex-field-list
2721 (substring (cdr (assoc "=type=" fields-alist))
2722 1)))) ; don't want @
2723 (dolist (field (car field-list))
2724 (unless (assoc-ignore-case (car field) fields-alist)
2725 (bibtex-make-field field)))
2726 (dolist (field (cdr field-list))
2727 (unless (assoc-ignore-case (car field) fields-alist)
2728 (bibtex-make-optional-field field))))))
2729
2683(defun bibtex-parse-entry () 2730(defun bibtex-parse-entry ()
2684 "Parse entry at point, return an alist. 2731 "Parse entry at point, return an alist.
2685The alist elements have the form (FIELD . TEXT), where FIELD can also be 2732The alist elements have the form (FIELD . TEXT), where FIELD can also be
2686the special strings \"=type=\" and \"=key=\"." 2733the special strings \"=type=\" and \"=key=\".
2734Move point to the end of the last field."
2687 (let (alist bounds) 2735 (let (alist bounds)
2688 (when (looking-at bibtex-entry-head) 2736 (when (looking-at bibtex-entry-head)
2689 (push (cons "=type=" (match-string bibtex-type-in-head)) alist) 2737 (push (cons "=type=" (match-string bibtex-type-in-head)) alist)
@@ -2774,28 +2822,14 @@ the special strings \"=type=\" and \"=key=\"."
2774 (looking-at "OPT\\|ALT")) 2822 (looking-at "OPT\\|ALT"))
2775 (match-end 0) mb) 2823 (match-end 0) mb)
2776 (bibtex-end-of-name-in-field bounds))) 2824 (bibtex-end-of-name-in-field bounds)))
2777 (entry-type (progn (re-search-backward 2825 (field-list (bibtex-field-list (progn (re-search-backward
2778 bibtex-entry-maybe-empty-head nil t) 2826 bibtex-entry-maybe-empty-head nil t)
2779 (bibtex-type-in-head))) 2827 (bibtex-type-in-head))))
2780 (entry-list (assoc-ignore-case entry-type 2828 (comment (assoc-ignore-case field-name
2781 bibtex-entry-field-alist)) 2829 (append (car field-list)
2782 (c-r-list (elt entry-list 2)) 2830 (cdr field-list)))))
2783 (req-opt-list (if (and (member entry-type
2784 bibtex-include-OPTcrossref)
2785 c-r-list)
2786 c-r-list
2787 (elt entry-list 1)))
2788 (list-of-entries (append (elt req-opt-list 0)
2789 (elt req-opt-list 1)
2790 bibtex-user-optional-fields
2791 (if (member entry-type
2792 bibtex-include-OPTcrossref)
2793 '(("crossref" "Reference key of the cross-referenced entry")))
2794 (if bibtex-include-OPTkey
2795 '(("key" "Used for reference key creation if author and editor fields are missing")))))
2796 (comment (assoc-ignore-case field-name list-of-entries)))
2797 (if comment 2831 (if comment
2798 (message (elt comment 1)) 2832 (message (nth 1 comment))
2799 (message "No comment available"))))) 2833 (message "No comment available")))))
2800 2834
2801(defun bibtex-make-field (field &optional called-by-yank) 2835(defun bibtex-make-field (field &optional called-by-yank)
@@ -2804,24 +2838,13 @@ FIELD is either a string or a list of the form
2804\(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in 2838\(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in
2805`bibtex-entry-field-alist'." 2839`bibtex-entry-field-alist'."
2806 (interactive 2840 (interactive
2807 (list (let* ((entry-type 2841 (list (let ((completion-ignore-case t)
2808 (save-excursion 2842 (field-list (bibtex-field-list
2809 (bibtex-enclosing-entry-maybe-empty-head) 2843 (save-excursion
2810 (bibtex-type-in-head))) 2844 (bibtex-enclosing-entry-maybe-empty-head)
2811 ;; "preliminary" completion list 2845 (bibtex-type-in-head)))))
2812 (fl (nth 1 (assoc-ignore-case 2846 (completing-read "BibTeX field name: "
2813 entry-type bibtex-entry-field-alist))) 2847 (append (car field-list) (cdr field-list))
2814 ;; "full" completion list
2815 (field-list (append (nth 0 fl)
2816 (nth 1 fl)
2817 bibtex-user-optional-fields
2818 (if (member entry-type
2819 bibtex-include-OPTcrossref)
2820 '(("crossref")))
2821 (if bibtex-include-OPTkey
2822 '(("key")))))
2823 (completion-ignore-case t))
2824 (completing-read "BibTeX field name: " field-list
2825 nil nil nil bibtex-field-history)))) 2848 nil nil nil bibtex-field-history))))
2826 (unless (consp field) 2849 (unless (consp field)
2827 (setq field (list field))) 2850 (setq field (list field)))
@@ -2848,8 +2871,9 @@ FIELD is either a string or a list of the form
2848 ((fboundp init) 2871 ((fboundp init)
2849 (insert (funcall init))))) 2872 (insert (funcall init)))))
2850 (if (not called-by-yank) (insert (bibtex-field-right-delimiter))) 2873 (if (not called-by-yank) (insert (bibtex-field-right-delimiter)))
2851 (if (interactive-p) 2874 (when (interactive-p)
2852 (forward-char -1))) 2875 (forward-char -1)
2876 (bibtex-print-help-message)))
2853 2877
2854(defun bibtex-beginning-of-entry () 2878(defun bibtex-beginning-of-entry ()
2855 "Move to beginning of BibTeX entry (beginning of line). 2879 "Move to beginning of BibTeX entry (beginning of line).
@@ -2982,13 +3006,14 @@ the entries of the BibTeX buffer. Return nil if no entry found."
2982 "\\(OPT\\)?crossref" t))) 3006 "\\(OPT\\)?crossref" t)))
2983 (list key 3007 (list key
2984 (if bounds (bibtex-text-in-field-bounds bounds t)) 3008 (if bounds (bibtex-text-in-field-bounds bounds t))
2985 entry-name)))) 3009 entry-name)))
2986 (list key nil entry-name))))) 3010 (list key nil entry-name))))))
2987 3011
2988(defun bibtex-lessp (index1 index2) 3012(defun bibtex-lessp (index1 index2)
2989 "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2. 3013 "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2.
2990Each index is a list (KEY CROSSREF-KEY ENTRY-NAME). 3014Each index is a list (KEY CROSSREF-KEY ENTRY-NAME).
2991The predicate depends on the variable `bibtex-maintain-sorted-entries'." 3015The predicate depends on the variable `bibtex-maintain-sorted-entries'.
3016If its value is nil use plain sorting."
2992 (cond ((not index1) (not index2)) ; indices can be nil 3017 (cond ((not index1) (not index2)) ; indices can be nil
2993 ((not index2) nil) 3018 ((not index2) nil)
2994 ((equal bibtex-maintain-sorted-entries 'crossref) 3019 ((equal bibtex-maintain-sorted-entries 'crossref)
@@ -3017,12 +3042,10 @@ The predicate depends on the variable `bibtex-maintain-sorted-entries'."
3017(defun bibtex-sort-buffer () 3042(defun bibtex-sort-buffer ()
3018 "Sort BibTeX buffer alphabetically by key. 3043 "Sort BibTeX buffer alphabetically by key.
3019The predicate for sorting is defined via `bibtex-maintain-sorted-entries'. 3044The predicate for sorting is defined via `bibtex-maintain-sorted-entries'.
3020Text outside of BibTeX entries is not affected. If 3045If its value is nil use plain sorting. Text outside of BibTeX entries is not
3021`bibtex-sort-ignore-string-entries' is non-nil, @String entries will be 3046affected. If `bibtex-sort-ignore-string-entries' is non-nil, @String entries
3022ignored." 3047will be ignored."
3023 (interactive) 3048 (interactive)
3024 (unless bibtex-maintain-sorted-entries
3025 (error "You must choose a sorting scheme"))
3026 (save-restriction 3049 (save-restriction
3027 (narrow-to-region (bibtex-beginning-of-first-entry) 3050 (narrow-to-region (bibtex-beginning-of-first-entry)
3028 (save-excursion (goto-char (point-max)) 3051 (save-excursion (goto-char (point-max))
@@ -3523,27 +3546,30 @@ At end of the cleaning process, the functions in
3523 (match-end bibtex-key-in-head))) 3546 (match-end bibtex-key-in-head)))
3524 (insert key)) 3547 (insert key))
3525 ;; sorting 3548 ;; sorting
3526 (let* ((start (bibtex-beginning-of-entry)) 3549 (unless called-by-reformat
3527 (end (progn (bibtex-end-of-entry) 3550 (let* ((start (bibtex-beginning-of-entry))
3528 (if (re-search-forward 3551 (end (progn (bibtex-end-of-entry)
3529 bibtex-entry-maybe-empty-head nil 'move) 3552 (if (re-search-forward
3530 (goto-char (match-beginning 0))) 3553 bibtex-entry-maybe-empty-head nil 'move)
3531 (point))) 3554 (goto-char (match-beginning 0)))
3532 (entry (buffer-substring start end)) 3555 (point)))
3533 (index (progn (goto-char start) 3556 (entry (buffer-substring start end))
3534 (bibtex-entry-index)))) 3557 (index (progn (goto-char start)
3535 (delete-region start end) 3558 (bibtex-entry-index)))
3536 (unless (prog1 (or called-by-reformat 3559 no-error)
3537 (if (and bibtex-maintain-sorted-entries 3560 (if (and bibtex-maintain-sorted-entries
3538 (not (and bibtex-sort-ignore-string-entries 3561 (not (and bibtex-sort-ignore-string-entries
3539 (equal entry-type "string")))) 3562 (equal entry-type "string"))))
3540 (bibtex-prepare-new-entry index) 3563 (progn
3541 (not (bibtex-find-entry (car index))))) 3564 (delete-region start end)
3542 (insert entry) 3565 (setq no-error (bibtex-prepare-new-entry index))
3543 (forward-char -1) 3566 (insert entry)
3544 (bibtex-beginning-of-entry) ; moves backward 3567 (forward-char -1)
3545 (re-search-forward bibtex-entry-head)) 3568 (bibtex-beginning-of-entry) ; moves backward
3546 (error "New inserted entry yields duplicate key"))) 3569 (re-search-forward bibtex-entry-head))
3570 (setq no-error (bibtex-find-entry (car index))))
3571 (unless no-error
3572 (error "New inserted entry yields duplicate key"))))
3547 ;; final clean up 3573 ;; final clean up
3548 (unless called-by-reformat 3574 (unless called-by-reformat
3549 (save-excursion 3575 (save-excursion
@@ -3621,91 +3647,89 @@ If `bibtex-align-at-equal-sign' is non-nil, align equal signs, too."
3621 (indent-to-column bibtex-entry-offset) 3647 (indent-to-column bibtex-entry-offset)
3622 (goto-char pnt))) 3648 (goto-char pnt)))
3623 3649
3624(defun bibtex-reformat (&optional additional-options called-by-convert-alien) 3650(defun bibtex-realign ()
3651 "Realign BibTeX entries such that they are separated by one blank line."
3652 (goto-char (point-min))
3653 (let ((case-fold-search t))
3654 (when (looking-at bibtex-valid-entry-whitespace-re)
3655 (replace-match "\\1"))
3656 (while (re-search-forward bibtex-valid-entry-whitespace-re nil t)
3657 (replace-match "\n\n\\1"))))
3658
3659(defun bibtex-reformat (&optional read-options)
3625 "Reformat all BibTeX entries in buffer or region. 3660 "Reformat all BibTeX entries in buffer or region.
3626With prefix argument, read options for reformatting from minibuffer. 3661With prefix argument, read options for reformatting from minibuffer.
3627With \\[universal-argument] \\[universal-argument] prefix argument, reuse previous answers (if any) again. 3662With \\[universal-argument] \\[universal-argument] prefix argument, reuse previous answers (if any) again.
3628If mark is active it reformats entries in region, if not in whole buffer." 3663If mark is active reformat entries in region, if not in whole buffer."
3629 (interactive "*P") 3664 (interactive "*P")
3630 (let* ((pnt (point)) 3665 (let* ((pnt (point))
3631 (use-previous-options 3666 (use-previous-options
3632 (and (equal (prefix-numeric-value additional-options) 16) 3667 (and (equal (prefix-numeric-value read-options) 16)
3633 (or bibtex-reformat-previous-options 3668 (or bibtex-reformat-previous-options
3634 bibtex-reformat-previous-reference-keys))) 3669 bibtex-reformat-previous-reference-keys)))
3635 (bibtex-entry-format 3670 (bibtex-entry-format
3636 (if additional-options 3671 (if read-options
3637 (if use-previous-options 3672 (if use-previous-options
3638 bibtex-reformat-previous-options 3673 bibtex-reformat-previous-options
3639 (setq bibtex-reformat-previous-options 3674 (setq bibtex-reformat-previous-options
3640 (delq nil (list 3675 (mapcar (lambda (option)
3641 (if (or called-by-convert-alien 3676 (if (y-or-n-p (car option)) (cdr option)))
3642 (y-or-n-p "Realign entries (recommended)? ")) 3677 `(("Realign entries (recommended)? " . 'realign)
3643 'realign) 3678 ("Remove empty optional and alternative fields? " . 'opts-or-alts)
3644 (if (y-or-n-p "Remove empty optional and alternative fields? ") 3679 ("Remove delimiters around pure numerical fields? " . 'numerical-fields)
3645 'opts-or-alts) 3680 (,(concat (if bibtex-comma-after-last-field "Insert" "Remove")
3646 (if (y-or-n-p "Remove delimiters around pure numerical fields? ") 3681 " comma at end of entry? ") . 'last-comma)
3647 'numerical-fields) 3682 ("Replace double page dashes by single ones? " . 'page-dashes)
3648 (if (y-or-n-p (concat (if bibtex-comma-after-last-field "Insert" "Remove") 3683 ("Force delimiters? " . 'delimiters)
3649 " comma at end of entry? ")) 3684 ("Unify case of entry types and field names? " . 'unify-case)))))
3650 'last-comma)
3651 (if (y-or-n-p "Replace double page dashes by single ones? ")
3652 'page-dashes)
3653 (if (y-or-n-p "Force delimiters? ")
3654 'delimiters)
3655 (if (y-or-n-p "Unify case of entry types and field names? ")
3656 'unify-case)))))
3657 '(realign))) 3685 '(realign)))
3658 (reformat-reference-keys (if additional-options 3686 (reformat-reference-keys
3659 (if use-previous-options 3687 (if read-options
3660 bibtex-reformat-previous-reference-keys 3688 (if use-previous-options
3661 (setq bibtex-reformat-previous-reference-keys 3689 bibtex-reformat-previous-reference-keys
3662 (y-or-n-p "Generate new reference keys automatically? "))))) 3690 (setq bibtex-reformat-previous-reference-keys
3663 bibtex-autokey-edit-before-use 3691 (y-or-n-p "Generate new reference keys automatically? ")))))
3664 (bibtex-sort-ignore-string-entries t)
3665 (start-point (if (bibtex-mark-active) 3692 (start-point (if (bibtex-mark-active)
3666 (region-beginning) 3693 (region-beginning)
3667 (bibtex-beginning-of-first-entry) 3694 (point-min)))
3668 (bibtex-skip-to-valid-entry)
3669 (point)))
3670 (end-point (if (bibtex-mark-active) 3695 (end-point (if (bibtex-mark-active)
3671 (region-end) 3696 (region-end)
3672 (point-max)))) 3697 (point-max)))
3698 (bibtex-sort-ignore-string-entries t)
3699 bibtex-autokey-edit-before-use)
3700
3673 (save-restriction 3701 (save-restriction
3674 (narrow-to-region start-point end-point) 3702 (narrow-to-region start-point end-point)
3675 (when (memq 'realign bibtex-entry-format) 3703 (if (memq 'realign bibtex-entry-format)
3676 (goto-char (point-min)) 3704 (bibtex-realign))
3677 (while (re-search-forward bibtex-valid-entry-whitespace-re nil t)
3678 (replace-match "\n\\1")))
3679 (goto-char start-point) 3705 (goto-char start-point)
3680 (bibtex-progress-message "Formatting" 1) 3706 (bibtex-progress-message "Formatting" 1)
3681 (bibtex-map-entries (lambda (key beg end) 3707 (bibtex-map-entries (lambda (key beg end)
3682 (bibtex-progress-message) 3708 (bibtex-progress-message)
3683 (bibtex-clean-entry reformat-reference-keys t) 3709 (bibtex-clean-entry reformat-reference-keys t)))
3684 (when (memq 'realign bibtex-entry-format) 3710 (when (memq 'realign bibtex-entry-format)
3685 (goto-char end) 3711 (bibtex-delete-whitespace)
3686 (bibtex-delete-whitespace) 3712 (open-line (if (eobp) 1 2)))
3687 (open-line 2))))
3688 (bibtex-progress-message 'done)) 3713 (bibtex-progress-message 'done))
3689 (when (and reformat-reference-keys 3714 (when (and reformat-reference-keys
3690 bibtex-maintain-sorted-entries 3715 bibtex-maintain-sorted-entries)
3691 (not called-by-convert-alien)) 3716 (bibtex-progress-message "Sorting" 1)
3692 (bibtex-sort-buffer) 3717 (bibtex-sort-buffer)
3693 (kill-local-variable 'bibtex-reference-keys)) 3718 (kill-local-variable 'bibtex-reference-keys)
3719 (bibtex-progress-message 'done))
3694 (goto-char pnt))) 3720 (goto-char pnt)))
3695 3721
3696(defun bibtex-convert-alien (&optional do-additional-reformatting) 3722(defun bibtex-convert-alien (&optional read-options)
3697 "Convert an alien BibTeX buffer to be fully usable by BibTeX mode. 3723 "Convert an alien BibTeX buffer to be fully usable by BibTeX mode.
3698If a file does not conform with some standards used by BibTeX mode, 3724If a file does not conform with all standards used by BibTeX mode,
3699some of the high-level features of BibTeX mode will not be available. 3725some of the high-level features of BibTeX mode will not be available.
3700This function tries to convert current buffer to conform with these standards. 3726This function tries to convert current buffer to conform with these standards.
3701With prefix argument DO-ADDITIONAL-REFORMATTING 3727With prefix argument READ-OPTIONS non-nil, read options for reformatting
3702non-nil, read options for reformatting entries from minibuffer." 3728entries from minibuffer."
3703 (interactive "*P") 3729 (interactive "*P")
3704 (message "Starting to validate buffer...") 3730 (message "Starting to validate buffer...")
3705 (sit-for 1 nil t) 3731 (sit-for 1 nil t)
3706 (goto-char (point-min)) 3732 (bibtex-realign)
3707 (while (re-search-forward "[ \t\n]+@" nil t)
3708 (replace-match "\n@"))
3709 (message 3733 (message
3710 "If errors occur, correct them and call `bibtex-convert-alien' again") 3734 "If errors occur, correct them and call `bibtex-convert-alien' again")
3711 (sit-for 5 nil t) 3735 (sit-for 5 nil t)
@@ -3714,10 +3738,7 @@ non-nil, read options for reformatting entries from minibuffer."
3714 (bibtex-validate)) 3738 (bibtex-validate))
3715 (message "Starting to reformat entries...") 3739 (message "Starting to reformat entries...")
3716 (sit-for 2 nil t) 3740 (sit-for 2 nil t)
3717 (bibtex-reformat do-additional-reformatting t) 3741 (bibtex-reformat read-options)
3718 (when bibtex-maintain-sorted-entries
3719 (message "Starting to sort buffer...")
3720 (bibtex-sort-buffer))
3721 (goto-char (point-max)) 3742 (goto-char (point-max))
3722 (message "Buffer is now parsable. Please save it."))) 3743 (message "Buffer is now parsable. Please save it.")))
3723 3744
@@ -3890,5 +3911,5 @@ is outside key or BibTeX field."
3890 3911
3891(provide 'bibtex) 3912(provide 'bibtex)
3892 3913
3893;;; arch-tag: ee2be3af-caad-427f-b42a-d20fad630d04 3914;; arch-tag: ee2be3af-caad-427f-b42a-d20fad630d04
3894;;; bibtex.el ends here 3915;;; bibtex.el ends here
diff --git a/lisp/toolbar/tool-bar.el b/lisp/toolbar/tool-bar.el
index 425789eb80e..6b890e5078f 100644
--- a/lisp/toolbar/tool-bar.el
+++ b/lisp/toolbar/tool-bar.el
@@ -239,11 +239,14 @@ MAP must contain appropriate binding for `[menu-bar]' which holds a keymap."
239 (tool-bar-add-item-from-menu 'undo "undo" nil 239 (tool-bar-add-item-from-menu 'undo "undo" nil
240 :visible '(not (eq 'special (get major-mode 240 :visible '(not (eq 'special (get major-mode
241 'mode-class)))) 241 'mode-class))))
242 (tool-bar-add-item-from-menu 'kill-region "cut" nil 242 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut])
243 "cut" nil
243 :visible '(not (eq 'special (get major-mode 244 :visible '(not (eq 'special (get major-mode
244 'mode-class)))) 245 'mode-class))))
245 (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy") 246 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy])
246 (tool-bar-add-item-from-menu 'yank "paste" nil 247 "copy")
248 (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste])
249 "paste" nil
247 :visible '(not (eq 'special (get major-mode 250 :visible '(not (eq 'special (get major-mode
248 'mode-class)))) 251 'mode-class))))
249 (tool-bar-add-item-from-menu 'nonincremental-search-forward "search") 252 (tool-bar-add-item-from-menu 'nonincremental-search-forward "search")
diff --git a/lisp/wdired.el b/lisp/wdired.el
index a8c36c2066f..30ba2a3cd45 100644
--- a/lisp/wdired.el
+++ b/lisp/wdired.el
@@ -329,8 +329,8 @@ See `wdired-mode'."
329 (buffer-enable-undo) ; Performance hack. See above. 329 (buffer-enable-undo) ; Performance hack. See above.
330 (set-buffer-modified-p nil) 330 (set-buffer-modified-p nil)
331 (setq buffer-undo-list nil) 331 (setq buffer-undo-list nil)
332 (run-hooks wdired-mode-hook) 332 (run-hooks 'wdired-mode-hook)
333 (message "Press C-c C-c when finished")) 333 (message (substitute-command-keys "Press \\[wdired-finish-edit] when finished")))
334 334
335 335
336;; Protect the buffer so only the filenames can be changed, and put 336;; Protect the buffer so only the filenames can be changed, and put
@@ -416,7 +416,8 @@ non-nil means return old filename."
416 (insert wdired-old-content)) 416 (insert wdired-old-content))
417 (wdired-change-to-dired-mode) 417 (wdired-change-to-dired-mode)
418 (set-buffer-modified-p nil) 418 (set-buffer-modified-p nil)
419 (setq buffer-undo-list nil)) 419 (setq buffer-undo-list nil)
420 (message "Changes aborted"))
420 421
421(defun wdired-finish-edit () 422(defun wdired-finish-edit ()
422 "Actually rename files based on your editing in the Dired buffer." 423 "Actually rename files based on your editing in the Dired buffer."
diff --git a/lisp/winner.el b/lisp/winner.el
index aaca331e7b3..e5b48889156 100644
--- a/lisp/winner.el
+++ b/lisp/winner.el
@@ -1,6 +1,6 @@
1;;; winner.el --- Restore old window configurations 1;;; winner.el --- Restore old window configurations
2 2
3;; Copyright (C) 1997, 1998, 2001 Free Software Foundation. Inc. 3;; Copyright (C) 1997, 1998, 2001, 2004 Free Software Foundation. Inc.
4 4
5;; Author: Ivar Rummelhoff <ivarru@math.uio.no> 5;; Author: Ivar Rummelhoff <ivarru@math.uio.no>
6;; Created: 27 Feb 1997 6;; Created: 27 Feb 1997
@@ -30,8 +30,8 @@
30;; window configuration (i.e. how the frames are partitioned into 30;; window configuration (i.e. how the frames are partitioned into
31;; windows) so that the changes can be "undone" using the command 31;; windows) so that the changes can be "undone" using the command
32;; `winner-undo'. By default this one is bound to the key sequence 32;; `winner-undo'. By default this one is bound to the key sequence
33;; ctrl-x left. If you change your mind (while undoing), you can 33;; ctrl-c left. If you change your mind (while undoing), you can
34;; press ctrl-x right (calling `winner-redo'). Even though it uses 34;; press ctrl-c right (calling `winner-redo'). Even though it uses
35;; some features of Emacs20.3, winner.el should also work with 35;; some features of Emacs20.3, winner.el should also work with
36;; Emacs19.34 and XEmacs20, provided that the installed version of 36;; Emacs19.34 and XEmacs20, provided that the installed version of
37;; custom is not obsolete. 37;; custom is not obsolete.
@@ -474,8 +474,8 @@ In other words, \"undo\" changes in window configuration."
474 474
475(unless winner-mode-map 475(unless winner-mode-map
476 (setq winner-mode-map (make-sparse-keymap)) 476 (setq winner-mode-map (make-sparse-keymap))
477 (define-key winner-mode-map [(control x) left] 'winner-undo) 477 (define-key winner-mode-map [(control c) left] 'winner-undo)
478 (define-key winner-mode-map [(control x) right] 'winner-redo)) 478 (define-key winner-mode-map [(control c) right] 'winner-redo))
479 479
480(unless (or (assq 'winner-mode minor-mode-map-alist) 480(unless (or (assq 'winner-mode minor-mode-map-alist)
481 winner-dont-bind-my-keys) 481 winner-dont-bind-my-keys)
diff --git a/lisp/xml.el b/lisp/xml.el
index db3292a4cfb..03ef6346c70 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -668,5 +668,5 @@ The first line is indented with INDENT-STRING."
668 668
669(provide 'xml) 669(provide 'xml)
670 670
671;;; arch-tag: 5864b283-5a68-4b59-a20d-36a72b353b9b 671;; arch-tag: 5864b283-5a68-4b59-a20d-36a72b353b9b
672;;; xml.el ends here 672;;; xml.el ends here