diff options
author | Karoly Lorentey <lorentey@elte.hu> | 2004-05-07 14:20:00 +0000 |
---|---|---|
committer | Karoly Lorentey <lorentey@elte.hu> | 2004-05-07 14:20:00 +0000 |
commit | 52f9ab73a16c71ffe7f8a1c25f9432bbe32f10cf (patch) | |
tree | 399c54ddfa7cac6c90a07a81308bf7f5e71b66bd /lisp | |
parent | b160ff41a813213adfa745a9d009ab638a22d7b1 (diff) | |
parent | a478f3e181bd9925ecb506abf4e49216d392124a (diff) | |
download | emacs-52f9ab73a16c71ffe7f8a1c25f9432bbe32f10cf.tar.gz emacs-52f9ab73a16c71ffe7f8a1c25f9432bbe32f10cf.tar.bz2 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/ChangeLog | 280 | ||||
-rw-r--r-- | lisp/comint.el | 96 | ||||
-rw-r--r-- | lisp/descr-text.el | 50 | ||||
-rw-r--r-- | lisp/diff-mode.el | 26 | ||||
-rw-r--r-- | lisp/ehelp.el | 22 | ||||
-rw-r--r-- | lisp/emacs-lisp/byte-run.el | 18 | ||||
-rw-r--r-- | lisp/emacs-lisp/re-builder.el | 2 | ||||
-rw-r--r-- | lisp/emulation/cua-base.el | 3 | ||||
-rw-r--r-- | lisp/gnus/ChangeLog | 4 | ||||
-rw-r--r-- | lisp/gnus/nnimap.el | 14 | ||||
-rw-r--r-- | lisp/help-fns.el | 113 | ||||
-rw-r--r-- | lisp/ibuffer.el | 3 | ||||
-rw-r--r-- | lisp/ido.el | 22 | ||||
-rw-r--r-- | lisp/ielm.el | 23 | ||||
-rw-r--r-- | lisp/iswitchb.el | 8 | ||||
-rw-r--r-- | lisp/makefile.nt | 284 | ||||
-rw-r--r-- | lisp/progmodes/compile.el | 51 | ||||
-rw-r--r-- | lisp/progmodes/gdb-ui.el | 91 | ||||
-rw-r--r-- | lisp/progmodes/python.el | 454 | ||||
-rw-r--r-- | lisp/progmodes/sql.el | 96 | ||||
-rw-r--r-- | lisp/ps-print.el | 27 | ||||
-rw-r--r-- | lisp/select.el | 83 | ||||
-rw-r--r-- | lisp/ses.el | 2 | ||||
-rw-r--r-- | lisp/simple.el | 3 | ||||
-rw-r--r-- | lisp/subr.el | 71 | ||||
-rw-r--r-- | lisp/term/w32-win.el | 6 | ||||
-rw-r--r-- | lisp/term/x-win.el | 5 | ||||
-rw-r--r-- | lisp/textmodes/bibtex.el | 525 | ||||
-rw-r--r-- | lisp/toolbar/tool-bar.el | 9 | ||||
-rw-r--r-- | lisp/wdired.el | 7 | ||||
-rw-r--r-- | lisp/winner.el | 10 | ||||
-rw-r--r-- | lisp/xml.el | 2 |
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 @@ + +2004-05-07 Juanma Barranquero <lektu@terra.es> + + * emacs-lisp/byte-run.el (make-obsolete, make-obsolete-variable): + Make argument names match their use in docstring. + + * subr.el (lambda): Add arglist description to docstring. + (declare): Fix typo in docstring. + (open-network-stream): Fix docstring. + (process-kill-without-query): Fix docstring and add obsolescence + info. + (last, butlast, nbutlast): Make arguments match their use in docstring. + (insert-buffer-substring-no-properties): Likewise. + (insert-buffer-substring-as-yank): Likewise. + (split-string): Fix docstring. + + * emacs-lisp/re-builder.el (reb-auto-update): Fix typo in docstring. + +2004-05-06 Nick Roberts <nickrob@gnu.org> + + * progmodes/gdb-ui.el: Improve/extend documentation strings. + Fit first sentence on one line for apropos-command. + +2004-05-06 Stefan Monnier <monnier@iro.umontreal.ca> + + Changes largely merged in from Dave Love's code. + * progmodes/python.el: Doc fixes. + (python-mode-map): Add python-complete-symbol. + (python-comment-line-p, python-beginning-of-string): Use syntax-ppss. + (python-comment-indent, python-complete-symbol) + (python-symbol-completions, python-partial-symbol) + (python-try-complete): New. + (python-indent-line): Remove optional arg. Use python-block-end-p. + (python-check): Bind compilation-error-regexp-alist. + (inferior-python-mode): Use rx. Move keybindings to top level. + Set comint-input-filter. + (python-preoutput-filter): Use rx. + (python-input-filter): Re-introduce. + (python-proc): Start new process if necessary. + Check python-buffer non-nil. + (view-return-to-alist): Defvar. + (python-send-receive): New. + (python-eldoc-function): Use it. + (python-mode-running): Don't defvar. + (python-mode): Set comment-indent-function. + Maybe update hippie-expand-try-functions-list. + (python-indentation-levels): Initialize differently. + (python-block-end-p): New. + (python-indent-line): Use it. + (python-compilation-regexp-alist): Augment. + (run-python): Import `emacs' module to Python rather than loading + code directly. Set python-buffer differently. + (python-send-region): Use emacs.eexecfile. Fix orig-start calculation. + Use python-proc. + (python-send-command): Go to end of comint buffer. + (python-load-file): Use python-proc, emacs.eimport. + (python-describe-symbol): Simplify interactive form. + Use emacs.help. Do use temp-buffer-show-hook. + Call print-help-return-message. + (hippie-exp): Require when compiling. + (python-preoutput-continuation): Use rx. + + * diff-mode.el (diff-make-unified): Fix regexp. + +2004-05-06 Romain Francoise <romain@orebokech.com> (tiny change) + + * ibuffer.el (ibuffer-redisplay-engine): Do not remove folded + filter groups from the buffer when rebuilding the Ibuffer buffer + and `ibuffer-show-empty-filter-groups' is nil. + +2004-05-06 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * ps-print.el (ps-print-quote): Call ps-value-string. + (ps-setup): Call ps-comment-string. + (ps-value-string, ps-comment-string): New funs. + +2004-05-06 Juanma Barranquero <lektu@terra.es> + + * help-fns.el (help-argument-name): Default to bold; don't inherit + from font-lock-variable-name-face. + (help-do-arg-highlight): Grok also ARGth occurrences in the docstring. + + * ehelp.el (electric-help-command-loop): Check whether the last + character is visible, not (point-max). + +2004-05-05 Kenichi Handa <handa@m17n.org> + + * descr-text.el (describe-char): Copy the character with text + properties and overlays into the first line, and call + describe-text-properties on it. + +2004-05-05 Stephen Eglen <stephen@anc.ed.ac.uk> + + * iswitchb.el (iswitchb-global-map): Fix typo. + Remove unwanted ###autoloads from source file. + +2004-05-05 Lars Hansen <larsh@math.ku.dk> + + * wdired.el (wdired-change-to-wdired-mode): Quote wdired-mode-hook + in run-hooks. Use substitute-command-keys in message. + (wdired-abort-changes): Add message. + +2004-05-03 Michael Mauger <mmaug@yahoo.com> + + * emacs/lisp/progmodes/sql.el (sql-xemacs-p, sql-emacs19-p) + (sql-emacs20-p): Remove. + (sql-mode-syntax-table): Use shared GNU EMacs/XEmacs syntax. + (sql-builtin-face, sql-doc-face): Remove. + (sql-mode-ansi-font-lock-keywords) + (sql-mode-oracle-font-lock-keywords) + (sql-mode-postgres-font-lock-keywords) + (sql-mode-linter-font-lock-keywords) + (sql-mode-ms-font-lock-keywords) + (sql-mode-mysql-font-lock-keywords): Use standard fonts. + (sql-product-font-lock): Fix font-lock reset when font rules change. + (sql-highlight-product): Remove incorrect font-lock reset logic. + +2004-05-04 Jonathan Yavner <jyavner@member.fsf.org> + + * ses.el (ses-set-parameter): Fix typo. + +2004-05-04 Kim F. Storm <storm@cua.dk> + + * ido.el (ido-read-internal): Fix call to read-file-name for edit. + Must expand directory for completion to work; and don't mess with + process-environment. + (ido-read-file-name): If command has ido property, don't use ido + if value is ignore, or read as directory if value is dir. + Set ido ignore property for dired-do-rename command. + +2004-05-04 Juanma Barranquero <lektu@terra.es> + + * help-fns.el (help-argument-name): New face, inheriting from + font-lock-variable-name-face, to highlight function arguments in + `describe-function' and `describe-key'. + (help-do-arg-highlight): Auxiliary function to highlight a given + list of arguments in a string. + (help-highlight-arguments): Highlight the function arguments and + all uses of them in the docstring. + (describe-function-1): Use it. Do docstring output via `insert', + not 'princ', so text attributes are preserved. + + * winner.el (winner-mode-map): Move winner-undo and winner-redo to + C-c <left> and C-c <right>, respectively (the previous bindings + conflict with prev-buffer, next-buffer). + + * ehelp.el (electric-help-command-loop, electric-help-undefined) + (electric-help-help): Check against unmapped commands. + +2004-05-03 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-progress-message): Fix docstring. + (bibtex-entry-update): New command bound to C-c C-u. + (bibtex-text-in-string): Fix regexp. + (bibtex-assoc-of-regexp): Remove. + (bibtex-progress-message): Fix docstring. + (bibtex-inside-field): Use if. + (bibtex-assoc-regexp): New function. + (bibtex-format-entry): Make code more robust so that it formats + also old entries. + (bibtex-autokey-demangle-title): Merge with obsolete function + bibtex-assoc-of-regexp. + (bibtex-field-list): New function. + (bibtex-entry): Use bibtex-field-list. + (bibtex-parse-entry): Fix docstring. + (bibtex-print-help-message): Use bibtex-field-list. + (bibtex-make-field): Use bibtex-field-list. + (bibtex-entry-index): Bugfix. Return crossref key if required. + (bibtex-lessp): Fix docstring. + +2004-05-03 Luc Teirlinck <teirllm@auburn.edu> + + * select.el (xselect-convert-to-string): Move comment to intended line. + +2004-05-03 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * toolbar/tool-bar.el (tool-bar-setup): Use lookup-key for + cut/copy/paste in case menu-bar-enable-clipboard is in effect. + +2004-05-03 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * term/x-win.el (x-clipboard-yank): Don't exit on error from + x-get-selection. + +2004-05-03 Jason Rumney <jasonr@gnu.org> + + * makefile.nt: Remove. + +2004-05-03 Kim F. Storm <storm@cua.dk> + + * emulation/cua-base.el (cua--update-indications): Fix last change. + (cua-mode): Deactivate mark when cua-mode is enabled. + +2004-05-02 Luc Teirlinck <teirllm@auburn.edu> + + * select.el (xselect-convert-to-string): Bind `inhibit-read-only' to t. + +2004-05-03 Nick Roberts <nickrob@gnu.org> + + * progmodes/gdb-ui.el (gud-watch, gdb-display-buffer) + (gdb-display-source-buffer, gdb-put-breakpoint-icon) + (gdb-remove-breakpoint-icons, gdb-assembler-custom): Look for + window over visible frames. + (gdb-goto-breakpoint): Make buffer display file at breakpoint. + +2004-05-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/compile.el (compilation-gcpro): New var. + (compilation-fake-loc): Use it. + (compilation-forget-errors): Reset it. + +2004-05-02 Dan Nicolaescu <dann@ics.uci.edu> + + * diff-mode.el (diff-header-face, diff-file-header-face): + Use min-colors. + +2004-05-02 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * textmodes/bibtex.el (bibtex-sort-buffer): Remove error message. + (bibtex-clean-entry): Disentangle code. + (bibtex-realign): New function. + (bibtex-reformat): Use mapcar and bibtex-realign. Do not use + bibtex-beginning-of-first-entry and bibtex-skip-to-valid-entry. + Remove undocumented optional arg called-by-convert-alien. + (bibtex-convert-alien): Use bibtex-realign. Use bibtex-reformat + for sorting instead of bibtex-sort-buffer. + +2004-05-02 Eli Zaretskii <eliz@gnu.org> + + * progmodes/compile.el (compilation-start): In the + no-async-subprocesses branch, call sit-for to give redisplay a + chance to show the updated process status in the mode line, and + fontify the buffer explicitly after the process exits. + +2004-05-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/python.el (python-compilation-line-number): Remove. + (python-compilation-regexp-alist): Don't use it any more. + (python-orig-start, python-input-filter): Remove. + (inferior-python-mode): Don't set up comint-input-filter-functions. + (python-send-region): Use compilation-fake-loc. + + * progmodes/compile.el (compilation-messages-start): New var. + (compilation-mode): Don't setup next-error-function here. + (compilation-setup): Set it up here instead (for minor modes as well). + Make compilation-messages-start buffer local. + (compilation-next-error-function): Use it. + (compilation-forget-errors): Set compilation-messages-start. + +2004-05-01 Luc Teirlinck <teirllm@auburn.edu> + + * ielm.el (ielm-prompt-read-only): Update docstring. + + * comint.el (comint-prompt-read-only): Update docstring. + (comint-update-fence, comint-kill-whole-line) + (comint-kill-region): New functions. + + * simple.el (kill-whole-line): Use "p" instead of "P" in + interactive form. + +2004-05-01 Juanma Barranquero <lektu@terra.es> + + * help-fns.el (help-add-fundoc-usage): Use %S instead of %s to + format arglist so default values in CL-style argument lists are + correctly shown. + +2004-05-01 Jason Rumney <jasonr@gnu.org> + + * term/w32-win.el (w32-drag-n-drop): Use x-dnd.el functions. + 2004-05-01 Kenichi Handa <handa@m17n.org> * international/titdic-cnv.el (miscdic-convert): Don't generate a @@ -35,7 +305,7 @@ * delsel.el: Don't put `delete-selection' property on `insert-parentheses' symbol to take advantage of region handling in `insert-pair' function. - Suggested by Stephan Stahl <stahl@eos.franken.de> + Suggested by Stephan Stahl <stahl@eos.franken.de>. 2004-04-30 Kim F. Storm <storm@cua.dk> @@ -65,7 +335,7 @@ New defmacro. (cua-upcase-rectangle, cua-downcase-rectangle): Use it. (cua-upcase-initials-rectangle, cua-capitalize-rectangle): - New commands (suggested by Jordan Breeding).. + New commands (suggested by Jordan Breeding). 2004-04-30 Juanma Barranquero <lektu@terra.es> @@ -5779,7 +6049,7 @@ 2003-08-12 Juri Linkov <juri@jurta.org> (tiny change) * simple.el (backward-word, forward-to-indentation) - (backward-to-indentation): Argument changed to optional. + (backward-to-indentation): Argument changed to optional. (next-line, previous-line): Use `or' instead of `unless'. 2003-08-12 Vinicius Jose Latorre <viniciusjl@ig.com.br> @@ -5961,7 +6231,7 @@ behaviour of `calendar-day-name' and `calendar-month-name' functions. (diary-name-pattern): Use abbrev arrays, rather than fixing abbrevs at three chars. Calling syntax change. - (mark-diary-entries): Adapt for new behaviours of + (mark-diary-entries): Adapt for new behaviours of `diary-name-pattern' and `calendar-make-alist' functions. (fancy-diary-font-lock-keywords): Adapt for new behaviour of `diary-name-pattern' function. @@ -6412,7 +6682,7 @@ 2003-07-08 Markus Rost <rost@math.ohio-state.edu> - * subr.el (dolist, dotimes): Doc fix. + * subr.el (dolist, dotimes): Doc fix. 2003-07-08 Kim F. Storm <storm@cua.dk> 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.") (defcustom comint-prompt-read-only nil "If non-nil, the comint prompt is read only. +The read only region includes the newline before the prompt. This does not affect existing prompts. -Certain derived modes may override this option." +Certain derived modes may override this option. + +If you set this option to t, then the safe way to temporarily +override the read-only-ness of comint prompts is to call +`comint-kill-whole-line' or `comint-kill-region' with no +narrowing in effect. This way you will be certain that none of +the remaining prompts will be accidentally messed up. You may +wish to put something like the following in your `.emacs' file: + +\(add-hook 'comint-mode-hook + '(lambda () + (define-key comint-mode-map \"\C-w\" 'comint-kill-region) + (define-key comint-mode-map [C-S-backspace] + 'comint-kill-whole-line))) + +If you sometimes use comint-mode on text-only terminals or with `emacs-nw', +you might wish to use another binding for `comint-kill-whole-line'." :type 'boolean :group 'comint :version "21.4") @@ -2311,6 +2328,83 @@ This command is like `M-.' in bash." (just-one-space))) +;; Support editing with `comint-prompt-read-only' set to t. + +(defun comint-update-fence () + "Update read-only status of newline before point. +The `fence' read-only property is used to indicate that a newline +is read-only for no other reason than to \"fence off\" a +following front-sticky read-only region. This is used to +implement comint read-only prompts. If the text after a newline +changes, the read-only status of that newline may need updating. +That is what this function does. + +This function does nothing if point is not at the beginning of a +line, or is at the beginning of the accessible portion of the buffer. +Otherwise, if the character after point has a front-sticky +read-only property, then the preceding newline is given a +read-only property of `fence', unless it already is read-only. +If the character after point does not have a front-sticky +read-only property, any read-only property of `fence' on the +preceding newline is removed." + (let* ((pt (point)) (lst (get-text-property pt 'front-sticky))) + (and (bolp) + (not (bobp)) + (if (and (get-text-property pt 'read-only) + (if (listp lst) (memq 'read-only lst) t)) + (unless (get-text-property (1- pt) 'read-only) + (put-text-property (1- pt) pt 'read-only 'fence)) + (when (eq (get-text-property (1- pt) 'read-only) 'fence) + (remove-list-of-text-properties (1- pt) pt '(read-only))))))) + +(defun comint-kill-whole-line (&optional arg) + "Kill current line, ignoring read-only and field properties. +With prefix arg, kill that many lines starting from the current line. +If arg is negative, kill backward. Also kill the preceding newline, +instead of the trailing one. \(This is meant to make C-x z work well +with negative arguments.) +If arg is zero, kill current line but exclude the trailing newline. +The read-only status of newlines is updated with `comint-update-fence', +if necessary." + (interactive "p") + (let ((inhibit-read-only t) (inhibit-field-text-motion t)) + (kill-whole-line arg) + (when (>= arg 0) (comint-update-fence)))) + +(defun comint-kill-region (beg end &optional yank-handler) + "Like `kill-region', but ignores read-only properties, if safe. +This command assumes that the buffer contains read-only +\"prompts\" which are regions with front-sticky read-only +properties at the beginning of a line, with the preceding newline +being read-only to protect the prompt. This is true of the +comint prompts if `comint-prompt-read-only' is non-nil. This +command will not delete the region if this would create mutilated +or out of place prompts. That is, if any part of a prompt is +deleted, the entire prompt must be deleted and all remaining +prompts should stay at the beginning of a line. If this is not +the case, this command just calls `kill-region' with all +read-only properties intact. The read-only status of newlines is +updated using `comint-update-fence', if necessary." + (interactive "r") + (save-excursion + (let* ((true-beg (min beg end)) + (true-end (max beg end)) + (beg-bolp (progn (goto-char true-beg) (bolp))) + (beg-lst (get-text-property true-beg 'front-sticky)) + (beg-bad (and (get-text-property true-beg 'read-only) + (if (listp beg-lst) (memq 'read-only beg-lst) t))) + (end-bolp (progn (goto-char true-end) (bolp))) + (end-lst (get-text-property true-end 'front-sticky)) + (end-bad (and (get-text-property true-end 'read-only) + (if (listp end-lst) (memq 'read-only end-lst) t)))) + (if (or (and (not beg-bolp) (or beg-bad end-bad)) + (and (not end-bolp) end-bad)) + (kill-region beg end yank-handler) + (let ((inhibit-read-only t)) + (kill-region beg end yank-handler) + (comint-update-fence)))))) + + ;; Support for source-file processing commands. ;;============================================================================ ;; 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." (if (>= pos (point-max)) (error "No character follows specified position")) (let* ((char (char-after pos)) + (char-string (buffer-substring pos (1+ pos))) (charset (char-charset char)) (buffer (current-buffer)) (composition (find-composition pos nil nil t)) @@ -474,16 +475,11 @@ as well as widgets, buttons, overlays, and text properties." standard-display-table)) (disp-vector (and display-table (aref display-table char))) (multibyte-p enable-multibyte-characters) - text-prop-description + (overlays (mapcar #'(lambda (o) (overlay-properties o)) + (overlays-at pos))) item-list max-width unicode) (if (eq charset 'unknown) - (setq item-list - `(("character" - ,(format "%s (0%o, %d, 0x%x) -- invalid character code" - (if (< char 256) - (single-key-description char) - (char-to-string char)) - char char char)))) + (setq item-list '("character")) (if (or (< char 256) (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos))) @@ -491,14 +487,7 @@ as well as widgets, buttons, overlays, and text properties." (setq unicode (or (get-char-property pos 'untranslated-utf-8) (encode-char char 'ucs)))) (setq item-list - `(("character" - ,(format "%s (0%o, %d, 0x%x%s)" (if (< char 256) - (single-key-description char) - (char-to-string char)) - char char char - (if unicode - (format ", U+%04X" unicode) - ""))) + `(("character") ("charset" ,(symbol-name charset) ,(format "(%s)" (charset-description charset))) @@ -583,18 +572,31 @@ as well as widgets, buttons, overlays, and text properties." (cons (list "Unicode data" " ") unicodedata)))))) (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) item-list))) - (setq text-prop-description - (with-temp-buffer - (let ((buf (current-buffer))) - (save-excursion - (set-buffer buffer) - (describe-text-properties pos buf))) - (buffer-string))) + (pop item-list) (with-output-to-temp-buffer "*Help*" (with-current-buffer standard-output (set-buffer-multibyte multibyte-p) (let ((formatter (format "%%%ds:" max-width))) + (insert (format formatter "character") " ") + (setq pos (point)) + (insert char-string + (format " (`%s', 0%o, %d, 0x%x" + (if (< char 256) + (single-key-description char) + (char-to-string char)) + char char char) + (if (eq charset 'unknown) + ") -- invalid character code\n" + (if unicode + (format ", U+%04X)\n" unicode) + ")\n"))) + (mapc #'(lambda (props) + (let ((o (make-overlay pos (1+ pos)))) + (while props + (overlay-put o (car props) (nth 1 props)) + (setq props (cddr props))))) + overlays) (dolist (elt item-list) (when (cadr elt) (insert (format formatter (car elt))) @@ -665,7 +667,7 @@ as well as widgets, buttons, overlays, and text properties." (insert "\nSee the variable `reference-point-alist' for " "the meaning of the rule.\n")) - (insert text-prop-description) + (describe-text-properties pos (current-buffer)) (describe-text-mode))))) (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)." ;;;; (defface diff-header-face - '((((type tty pc) (class color) (background light)) - (:foreground "blue1" :weight bold)) - (((type tty pc) (class color) (background dark)) - (:foreground "green" :weight bold)) - (((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "grey85")) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "grey45")) + (((class color) (background light)) + (:foreground "blue1" :weight bold)) + (((class color) (background dark)) + (:foreground "green" :weight bold)) (t (:weight bold))) "`diff-mode' face inherited by hunk and index header faces.") (defvar diff-header-face 'diff-header-face) (defface diff-file-header-face - '((((type tty pc) (class color) (background light)) - (:foreground "yellow" :weight bold)) - (((type tty pc) (class color) (background dark)) - (:foreground "cyan" :weight bold)) - (((class color) (background light)) + '((((class color) (min-colors 88) (background light)) (:background "grey70" :weight bold)) - (((class color) (background dark)) + (((class color) (min-colors 88) (background dark)) (:background "grey60" :weight bold)) + (((class color) (background light)) + (:foreground "yellow" :weight bold)) + (((class color) (background dark)) + (:foreground "cyan" :weight bold)) (t (:weight bold))) ; :height 1.3 "`diff-mode' face used to highlight file header lines.") (defvar diff-file-header-face 'diff-file-header-face) @@ -976,7 +976,7 @@ a diff with \\[diff-reverse-direction]." "Turn context diffs into unified diffs if applicable." (if (save-excursion (goto-char (point-min)) - (looking-at "\\*\\*\\* ")) + (and (looking-at diff-hunk-header-re) (eq (char-after) ?*))) (let ((mod (buffer-modified-p))) (unwind-protect (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 @@ ;;; ehelp.el --- bindings for electric-help mode -;; Copyright (C) 1986, 1995, 2000, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1986, 1995, 2000, 2001, 2004 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: help, extensions @@ -200,13 +200,13 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit." (progn (setq unread-command-events nil) (throw 'exit t))))) (let (up down both neither - (standard (and (eq (key-binding " ") + (standard (and (eq (key-binding " " nil t) 'scroll-up) - (eq (key-binding "\^?") + (eq (key-binding "\^?" nil t) 'scroll-down) - (eq (key-binding "q") + (eq (key-binding "q" nil t) 'electric-help-exit) - (eq (key-binding "r") + (eq (key-binding "r" nil t) 'electric-help-retain)))) (Electric-command-loop 'exit @@ -215,7 +215,7 @@ BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit." ;beginning-of-buffer - otherwise pos-visible-in-window-p ;will yield a wrong result. (let ((min (pos-visible-in-window-p (point-min))) - (max (pos-visible-in-window-p (point-max)))) + (max (pos-visible-in-window-p (1- (point-max))))) (cond (isearch-mode 'noprompt) ((and min max) (cond (standard "Press q to exit, r to retain ") @@ -272,7 +272,7 @@ will select it.)" (interactive) (error "%s is undefined -- Press %s to exit" (mapconcat 'single-key-description (this-command-keys) " ") - (if (eq (key-binding "q") 'electric-help-exit) + (if (eq (key-binding "q" nil t) 'electric-help-exit) "q" (substitute-command-keys "\\[electric-help-exit]")))) @@ -280,10 +280,10 @@ will select it.)" ;>>> this needs to be hairified (recursive help, anybody?) (defun electric-help-help () (interactive) - (if (and (eq (key-binding "q") 'electric-help-exit) - (eq (key-binding " ") 'scroll-up) - (eq (key-binding "\^?") 'scroll-down) - (eq (key-binding "r") 'electric-help-retain)) + (if (and (eq (key-binding "q" nil t) 'electric-help-exit) + (eq (key-binding " " nil t) 'scroll-up) + (eq (key-binding "\^?" nil t) 'scroll-down) + (eq (key-binding "r" nil t) 'electric-help-retain)) (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits") (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits"))) (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 @@ (eval-and-compile (put ',name 'byte-optimizer 'byte-compile-inline-expand)))) -(defun make-obsolete (fn new &optional when) +(defun make-obsolete (function new &optional when) "Make the byte-compiler warn that FUNCTION is obsolete. The warning will say that NEW should be used instead. If NEW is a string, that is the `use instead' message. If provided, WHEN should be a string indicating when the function was first made obsolete, for example a date or a release number." (interactive "aMake function obsolete: \nxObsoletion replacement: ") - (let ((handler (get fn 'byte-compile))) + (let ((handler (get function 'byte-compile))) (if (eq 'byte-compile-obsolete handler) - (setq handler (nth 1 (get fn 'byte-obsolete-info))) - (put fn 'byte-compile 'byte-compile-obsolete)) - (put fn 'byte-obsolete-info (list new handler when))) - fn) + (setq handler (nth 1 (get function 'byte-obsolete-info))) + (put function 'byte-compile 'byte-compile-obsolete)) + (put function 'byte-obsolete-info (list new handler when))) + function) -(defun make-obsolete-variable (var new &optional when) +(defun make-obsolete-variable (variable new &optional when) "Make the byte-compiler warn that VARIABLE is obsolete. The warning will say that NEW should be used instead. If 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." (if (equal str "") (error "")) (intern str)) (car (read-from-string (read-string "Obsoletion replacement: "))))) - (put var 'byte-obsolete-variable (cons new when)) - var) + (put variable 'byte-obsolete-variable (cons new when)) + variable) (put 'dont-compile 'lisp-indent-hook 0) (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." (defun reb-auto-update (beg end lenold &optional force) "Called from `after-update-functions' to update the display. -BEG END and LENOLD are passed in from the hook. +BEG, END and LENOLD are passed in from the hook. An actual update is only done if the regexp has changed or if the optional fourth argument FORCE is non-nil." (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." (set-cursor-color color)) (if (and type (symbolp type) - (not (eq type (frame-parameter nil 'cursor-type)))) + (not (eq type default-cursor-type))) (setq default-cursor-type type)))) @@ -1336,6 +1336,7 @@ paste (in addition to the normal emacs bindings)." (delete-selection-mode -1)) (if (and (boundp 'pc-selection-mode) pc-selection-mode) (pc-selection-mode -1)) + (cua--deactivate) (setq transient-mark-mode (and cua-mode (if cua-highlight-region-shift-only (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 @@ +2004-05-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * nnimap.el (nnimap-demule): Avoid string-as-multibyte. + 2004-03-27 Juanma Barranquero <lektu@terra.es> * 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 @@ ;;; nnimap.el --- imap backend for Gnus -;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc. + +;; Copyright (C) 1998,1999,2000,01,02,2004 Free Software Foundation, Inc. ;; Author: Simon Josefsson <jas@pdc.kth.se> ;; Jim Radford <radford@robby.caltech.edu> @@ -671,9 +672,12 @@ function is generally only called when Gnus is shutting down." (nnoo-status-message 'nnimap server))) (defun nnimap-demule (string) - (funcall (if (and (fboundp 'string-as-multibyte) - (subrp (symbol-function 'string-as-multibyte))) - 'string-as-multibyte + ;; BEWARE: we used to use string-as-multibyte here which is braindead + ;; because it will turn accidental emacs-mule-valid byte sequences + ;; into multibyte chars. --Stef + (funcall (if (and (fboundp 'string-to-multibyte) + (subrp (symbol-function 'string-to-multibyte))) + 'string-to-multibyte 'identity) (or string ""))) @@ -1383,5 +1387,5 @@ sure of changing the value of `foo'." (provide 'nnimap) -;;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b +;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b ;;; 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 ...)\"." (unless (stringp doc) (setq doc "Not documented")) (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" doc) (eq arglist t)) doc - (format "%s%s%s" doc + (format "%s%s%S" doc (if (string-match "\n?\n\\'" doc) (if (< (- (match-end 0) (match-beginning 0)) 2) "\n" "") "\n\n") @@ -237,6 +237,43 @@ KIND should be `var' for a variable or `subr' for a subroutine." (concat "src/" file) file))))) +(defface help-argument-name '((t (:weight bold))) + "Face to highlight function arguments in docstrings.") + +(defun help-do-arg-highlight (doc args) + (while args + (let ((arg (prog1 (car args) (setq args (cdr args))))) + (setq doc (replace-regexp-in-string + (concat "\\<\\(" arg "\\)\\(?:es\\|s\\|th\\)?\\>") + (propertize arg 'face 'help-argument-name) + doc t t 1)))) + doc) + +(defun help-highlight-arguments (usage doc &rest args) + (when usage + (let ((case-fold-search nil) + (next (not args))) + ;; Make a list of all arguments + (with-temp-buffer + (insert usage) + (goto-char (point-min)) + ;; Make a list of all arguments + (while next + (if (not (re-search-forward " \\([\\[(]?\\)\\([^] &)\.]+\\)" nil t)) + (setq next nil) + (setq args (cons (match-string 2) args)) + (when (string= (match-string 1) "(") + ;; A pesky CL-style optional argument with default value, + ;; so let's skip over it + (search-backward "(") + (goto-char (scan-sexps (point) 1))))) + ;; Highlight aguments in the USAGE string + (setq usage (help-do-arg-highlight (buffer-string) args))) + ;; Highlight arguments in the DOC string + (setq doc (and doc (help-do-arg-highlight doc args))) + ;; Return value is like the one from help-split-fundoc, but highlighted + (cons usage doc)))) + ;;;###autoload (defun describe-function-1 (function) (let* ((def (if (symbolp function) @@ -339,7 +376,7 @@ KIND should be `var' for a variable or `subr' for a subroutine." ;; FIXME: This list can be very long (f.ex. for self-insert-command). ;; If there are many, remove them from KEYS. (if (< (length non-modified-keys) 10) - (princ (mapconcat 'key-description keys ", ")) + (princ (mapconcat 'key-description keys ", ")) (dolist (key non-modified-keys) (setq keys (delq key keys))) (if keys @@ -353,40 +390,44 @@ KIND should be `var' for a variable or `subr' for a subroutine." (let* ((arglist (help-function-arglist def)) (doc (documentation function)) (usage (help-split-fundoc doc function))) - ;; If definition is a keymap, skip arglist note. - (unless (keymapp def) - (princ (cond - (usage (setq doc (cdr usage)) (car usage)) - ((listp arglist) (help-make-usage function arglist)) - ((stringp arglist) arglist) - ;; Maybe the arglist is in the docstring of the alias. - ((let ((fun function)) - (while (and (symbolp fun) - (setq fun (symbol-function fun)) - (not (setq usage (help-split-fundoc - (documentation fun) - function))))) - usage) - (car usage)) - ((or (stringp def) - (vectorp def)) - (format "\nMacro: %s" (format-kbd-macro def))) - (t "[Missing arglist. Please make a bug report.]"))) - (terpri)) - (let ((obsolete (and - ;; function might be a lambda construct. - (symbolp function) - (get function 'byte-obsolete-info)))) - (when obsolete - (terpri) - (princ "This function is obsolete") - (if (nth 2 obsolete) (princ (format " since %s" (nth 2 obsolete)))) - (princ ";") (terpri) - (princ (if (stringp (car obsolete)) (car obsolete) - (format "use `%s' instead." (car obsolete)))) - (terpri))) - (terpri) - (princ (or doc "Not documented."))))) + (with-current-buffer standard-output + ;; If definition is a keymap, skip arglist note. + (unless (keymapp def) + (let* ((use (cond + (usage (setq doc (cdr usage)) (car usage)) + ((listp arglist) + (format "%S" (help-make-usage function arglist))) + ((stringp arglist) arglist) + ;; Maybe the arglist is in the docstring of the alias. + ((let ((fun function)) + (while (and (symbolp fun) + (setq fun (symbol-function fun)) + (not (setq usage (help-split-fundoc + (documentation fun) + function))))) + usage) + (car usage)) + ((or (stringp def) + (vectorp def)) + (format "\nMacro: %s" (format-kbd-macro def))) + (t "[Missing arglist. Please make a bug report.]"))) + (high (help-highlight-arguments use doc))) + (insert (car high) "\n") + (setq doc (cdr high)))) + (let ((obsolete (and + ;; function might be a lambda construct. + (symbolp function) + (get function 'byte-obsolete-info)))) + (when obsolete + (princ "\nThis function is obsolete") + (when (nth 2 obsolete) + (insert (format " since %s" (nth 2 obsolete)))) + (insert ";\n" + (if (stringp (car obsolete)) (car obsolete) + (format "use `%s' instead." (car obsolete))) + "\n")) + (insert "\n" + (or doc "Not documented."))))))) ;; 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 @@ ;;; ibuffer.el --- operate on buffers like dired -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Colin Walters <walters@verbum.org> ;; Maintainer: John Paul Wallington <jpw@gnu.org> @@ -2166,6 +2166,7 @@ If optional arg SILENT is non-nil, do not display progress messages." (member name ibuffer-hidden-filter-groups))) (bmarklist (cdr group))) (unless (and (null bmarklist) + (not disabled) ext-loaded (null ibuffer-show-empty-filter-groups)) (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 @@ ;;; ido.el --- interactively do things with buffers and files. -;; Copyright (C) 1996-2003 Free Software Foundation, Inc. +;; Copyright (C) 1996-2004 Free Software Foundation, Inc. ;; Author: Kim F. Storm <storm@cua.dk> ;; Based on: iswitchb by Stephen Eglen <stephen@cns.ed.ac.uk> @@ -30,8 +30,9 @@ ;; for ido-switch-buffer and found the inspiration for ido-find-file. ;; The ido package would never have existed without his work. -;; Also thanks to Klaus Berndl, Rohit Namjoshi, Robert Fenk, Alex Schroeder, -;; Bill Benedetto, and Stephen Eglen for bug fixes and improvements. +;; Also thanks to Klaus Berndl, Rohit Namjoshi, Robert Fenk, Alex +;; Schroeder, Bill Benedetto, Stephen Eglen, and many others for bug +;; fixes and improvements. ;;; History @@ -55,7 +56,7 @@ ;; so I invented a common "ido-" namespace for the merged packages. ;; ;; This version is based on ido.el version 1.57 released on -;; gnu.emacs.sources adapted for emacs 21.4 to use command remapping +;; gnu.emacs.sources adapted for emacs 21.5 to use command remapping ;; and optionally hooking the read-buffer and read-file-name functions. ;; ;; 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." ((memq ido-exit '(edit chdir)) (cond ((memq ido-cur-item '(file dir)) - (let* ((process-environment (cons "HOME=/" process-environment)) ;; cheat read-file-name - (read-file-name-function nil) + (let* ((read-file-name-function nil) (edit (eq ido-exit 'edit)) (d ido-current-directory) (f ido-text-init) @@ -1676,7 +1676,9 @@ If INITIAL is non-nil, it specifies the initial input string." (setq ido-text-init "") (while new (setq new (if edit - (read-file-name (concat prompt "[EDIT] ") d (concat d f) nil f) + (read-file-name (concat prompt "[EDIT] ") + (expand-file-name d) + (concat d f) nil f) f) d (or (file-name-directory new) "/") f (file-name-nondirectory new) @@ -3807,15 +3809,19 @@ For details of keybindings, do `\\[describe-function] ido-find-file'." ;;; Helper functions for other programs +(put 'dired-do-rename 'ido 'ignore) + ;;;###autoload (defun ido-read-file-name (prompt &optional dir default-filename mustmatch initial predicate) "Read file name, prompting with PROMPT and completing in directory DIR. See `read-file-name' for additional parameters." (cond ((or (eq predicate 'file-directory-p) + (eq (get this-command 'ido) 'dir) (memq this-command ido-read-file-name-as-directory-commands)) (ido-read-directory-name prompt dir default-filename mustmatch initial)) - ((and (not (memq this-command ido-read-file-name-non-ido)) + ((and (not (eq (get this-command 'ido) 'ignore)) + (not (memq this-command ido-read-file-name-non-ido)) (or (null predicate) (eq predicate 'file-exists-p))) (let* (filename 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 @@ (defcustom ielm-prompt-read-only t "If non-nil, the IELM prompt is read only. +The read only region includes the newline before the prompt. Setting this variable does not affect existing IELM runs. This works by setting the buffer-local value of `comint-prompt-read-only'. -Setting that value directly affects new prompts in the current buffer." +Setting that value directly affects new prompts in the current buffer. + +If this option is enabled, then the safe way to temporarily +override the read-only-ness of ielm prompts is to call +`comint-kill-whole-line' or `comint-kill-region' with no +narrowing in effect. This way you will be certain that none of +the remaining prompts will be accidentally messed up. You may +wish to put something like the following in your `.emacs' file: + +\(add-hook 'ielm-mode-hook + '(lambda () + (define-key ielm-map \"\C-w\" 'comint-kill-region) + (define-key ielm-map [C-S-backspace] + 'comint-kill-whole-line))) + +If you set `comint-prompt-read-only' to t, you might wish to use +`comint-mode-hook' and `comint-mode-map' instead of +`ielm-mode-hook' and `ielm-map'. That will affect all comint +buffers, including ielm buffers. If you sometimes use ielm on +text-only terminals or with `emacs -nw', you might wish to use +another binding for `comint-kill-whole-line'." :type 'boolean :group 'ielm :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.") (substitute-key-definition 'display-buffer ; C-x 4 C-o 'iswitchb-display-buffer map global-map) map) - "Global keymap for `iswtichb-mode'.") + "Global keymap for `iswitchb-mode'.") (defvar iswitchb-history nil "History of buffers selected using `iswitchb-buffer'.") @@ -571,7 +571,6 @@ in a separate window. (iswitchb-possible-new-buffer buf))) )))) -;;;###autoload (defun iswitchb-read-buffer (prompt &optional default require-match) "Replacement for the built-in `read-buffer'. Return the name of a buffer selected. @@ -1073,7 +1072,6 @@ If BUFFER is visible in the current frame, return nil." (get-buffer-window buffer 0) ; better than 'visible ))) -;;;###autoload (defun iswitchb-default-keybindings () "Set up default keybindings for `iswitchb-buffer'. Call this function to override the normal bindings. This function also @@ -1087,7 +1085,6 @@ Obsolescent. Use `iswitchb-mode'." (global-set-key "\C-x4\C-o" 'iswitchb-display-buffer) (global-set-key "\C-x5b" 'iswitchb-buffer-other-frame)) -;;;###autoload (defun iswitchb-buffer () "Switch to another buffer. @@ -1100,7 +1097,6 @@ For details of keybindings, do `\\[describe-function] iswitchb'." (setq iswitchb-method iswitchb-default-method) (iswitchb)) -;;;###autoload (defun iswitchb-buffer-other-window () "Switch to another buffer and show it in another window. The buffer name is selected interactively by typing a substring. @@ -1109,7 +1105,6 @@ For details of keybindings, do `\\[describe-function] iswitchb'." (setq iswitchb-method 'otherwindow) (iswitchb)) -;;;###autoload (defun iswitchb-display-buffer () "Display a buffer in another window but don't select it. The buffer name is selected interactively by typing a substring. @@ -1118,7 +1113,6 @@ For details of keybindings, do `\\[describe-function] iswitchb'." (setq iswitchb-method 'display) (iswitchb)) -;;;###autoload (defun iswitchb-buffer-other-frame () "Switch to another buffer and show it in another frame. The 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 @@ -# Hacked up Nmake makefile for GNU Emacs -# Geoff Voelker (voelker@cs.washington.edu) -# Copyright (c) 1994 Free Software Foundation, Inc. -# -# This file is part of GNU Emacs. -# -# GNU Emacs is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2, or (at your option) -# any later version. -# -# GNU Emacs is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with GNU Emacs; see the file COPYING. If not, write to the -# Free Software Foundation, Inc., 59 Temple Place - Suite 330, -# Boston, MA 02111-1307, USA. -# - -!include ..\nt\makefile.def - -all: - -#lisp=$(MAKEDIR:\=/) -lisp=. - -# You can specify a different executable on the make command line, -# e.g. "make EMACS=../src/emacs ...". - -EMACS = ..\bin\emacs.exe - -# Command line flags for Emacs. This must include --multibyte, -# otherwise some files will not compile. - -EMACSOPT = -batch --no-init-file --no-site-file --multibyte - -lisptagsfiles1 = $(lisp)/*.el -lisptagsfiles2 = $(lisp)/*/*.el -ETAGS = ..\lib-src\$(BLD)\etags - -# Files which should not be compiled. -# - emacs-lisp/cl-specs.el: only contains `def-edebug-spec's so there's -# no point compiling it, although it doesn't hurt. - -DONTCOMPILE = \ - $(lisp)/cus-load.el \ - $(lisp)/cus-start.el \ - $(lisp)/emacs-lisp/cl-specs.el \ - $(lisp)/eshell/esh-maint.el \ - $(lisp)/eshell/esh-groups.el \ - $(lisp)/finder-inf.el \ - $(lisp)/forms-d2.el \ - $(lisp)/forms-pass.el \ - $(lisp)/generic-x.el \ - $(lisp)/international/latin-1.el \ - $(lisp)/international/latin-2.el \ - $(lisp)/international/latin-3.el \ - $(lisp)/international/latin-4.el \ - $(lisp)/international/latin-5.el \ - $(lisp)/international/latin-8.el \ - $(lisp)/international/latin-9.el \ - $(lisp)/international/mule-conf.el \ - $(lisp)/loaddefs.el \ - $(lisp)/loadup.el \ - $(lisp)/mail/blessmail.el \ - $(lisp)/patcomp.el \ - $(lisp)/paths.el \ - $(lisp)/play/bruce.el \ - $(lisp)/subdirs.el \ - $(lisp)/term/internal.el \ - $(lisp)/term/AT386.el \ - $(lisp)/term/apollo.el \ - $(lisp)/term/bobcat.el \ - $(lisp)/term/iris-ansi.el \ - $(lisp)/term/keyswap.el \ - $(lisp)/term/linux.el \ - $(lisp)/term/lk201.el \ - $(lisp)/term/news.el \ - $(lisp)/term/vt102.el \ - $(lisp)/term/vt125.el \ - $(lisp)/term/vt200.el \ - $(lisp)/term/vt201.el \ - $(lisp)/term/vt220.el \ - $(lisp)/term/vt240.el \ - $(lisp)/term/vt300.el \ - $(lisp)/term/vt320.el \ - $(lisp)/term/vt400.el \ - $(lisp)/term/vt420.el \ - $(lisp)/term/wyse50.el \ - $(lisp)/term/xterm.el \ - $(lisp)/version.el - -# Files to compile before others during a bootstrap. This is done -# to speed up the bootstrap process. - -COMPILE_FIRST = \ - $(lisp)/emacs-lisp/byte-opt.el \ - $(lisp)/emacs-lisp/bytecomp.el \ - $(lisp)/subr.el - -# The actual Emacs command run in the targets below. - -emacs = $(EMACS) $(EMACSOPT) - -# Common command to find subdirectories - -# setwins=subdirs=`find $$wd -type d -print`; \ -# for file in $$subdirs; do \ -# case $$file in */Old | */RCS | */CVS | */CVS/* | */=* ) ;; \ -# *) wins="$$wins $$file" ;; \ -# esac; \ -# done - -# Have to define the list of subdirs manually -WINS=\ - calendar \ - emacs-lisp \ - emulation \ - eshell \ - gnus \ - international \ - language \ - mail \ - mh-e \ - net \ - play \ - progmodes \ - term \ - textmodes - -doit: - -cus-load.el: - touch $@ -custom-deps: cus-load.el doit - @echo Directories: $(WINS) - $(emacs) -l cus-dep --eval "(setq find-file-hooks nil)" -f custom-make-dependencies $(lisp) $(WINS) - -finder-inf.el: - echo (provide 'finder-inf)>> $@ - -finder-data: finder-inf.el doit - @echo Directories: $(WINS) - $(emacs) -l finder -f finder-compile-keywords-make-dist $(lisp) $(WINS) - -loaddefs.el: - echo ;;; loaddefs.el --- automatically extracted autoloads> $@ - echo ;;; Code:>> $@ - echo >> $@ - echo ;;; Local Variables:>> $@ - echo ;;; version-control: never>> $@ - echo ;;; no-byte-compile: t>> $@ - echo ;;; no-update-autoloads: t>> $@ - echo ;;; End:>> $@ - echo ;;; loaddefs.el ends here>> $@ - -autoloads: loaddefs.el doit - @echo Directories: $(WINS) - $(emacs) -l autoload --eval "(setq find-file-hooks nil generated-autoload-file \"$(lisp)/loaddefs.el\")" -f batch-update-autoloads $(lisp) $(WINS) - -subdirs.el: - $(MAKE) $(MFLAGS) -f makefile.nt update-subdirs -update-subdirs: doit - @set QWINS= - @for %d in ($(WINS)) do if not (%d)==(term) set QWINS=%QWINS% "%d" - echo ;; In load-path, after this directory should come> subdirs.el - echo ;; certain of its subdirectories. Here we specify them.>> subdirs.el - echo (normal-top-level-add-to-load-path '(%QWINS%))>> subdirs.el - -updates: update-subdirs autoloads finder-data custom-deps - -TAGS: $(lisptagsfiles1) $(lisptagsfiles2) - $(ETAGS) $(lisptagsfiles1) $(lisptagsfiles2) - -TAGS-LISP: $(lispsource)$(lisptagsfiles1) $(lispsource)$(lisptagsfiles2) - $(ETAGS) -o TAGS-LISP $(lispsource)$(lisptagsfiles1) $(lispsource)$(lisptagsfiles2) - -.SUFFIXES: .elc .el - -.el.elc: - -$(emacs) -f batch-byte-compile $< - -$(DONTCOMPILE:.el=.elc): - -$(DEL) $@ - -# Compile all Lisp files, except those from DONTCOMPILE. This -# compiles files unconditionally. All .elc files are made writable -# before compilation in case we checked out read-only (CVS option -r). -# Files MUST be compiled one by one. If we compile several files in a -# row we can't make sure that the compilation environment is clean. -# We also set the load-path of the Emacs used for compilation to the -# current directory and its subdirectories, to make sure require's and -# load's in the files being compiled find the right files. - -compile-files: subdirs.el doit -# -for %f in ($(lisp) $(WINS)) do for %g in (%f\*.elc) do @attrib -r %g - for %f in ($(COMPILE_FIRST)) do $(emacs) -f batch-byte-compile %f - for %f in ($(lisp) $(WINS)) do for %g in (%f/*.el) do $(emacs) -f batch-byte-compile %f/%g - -# Backup compiled Lisp files in elc.tar.gz. If that file already -# exists, make a backup of it. - -backup-compiled-files: - -mv $(lisp)/elc.tar.gz $(lisp)/elc.tar.gz~ - -tar czf $(lisp)/elc.tar.gz $(lisp)/*.elc $(lisp)/*/*.elc - -# Compile Lisp files, but save old compiled files first. - -compile: backup-compiled-files compile-files - -# Recompile all Lisp files which are newer than their .elc files. -# Note that this doesn't create .elc files. It only recompiles if an -# .elc is present. - -recompile: doit - $(emacs) -f batch-byte-recompile-directory . - -# Prepare a bootstrap in the lisp subdirectory. Build loaddefs.el, -# because it's not sure it's up-to-date, and if it's not, that might -# lead to errors during the bootstrap because something fails to -# autoload as expected. Remove compiled Lisp files so that -# bootstrap-emacs will be built from sources only. - -bootstrap-clean: - if exist $(EMACS) $(MAKE) $(MFLAGS) -f makefile.nt autoloads - -for %f in ($(lisp) $(WINS)) do for %g in (%f\*.elc) do @$(DEL) %g - -# Generate/update files for the bootstrap process. - -bootstrap: autoloads compile-files custom-deps - -# -# Assuming INSTALL_DIR is defined, copy the elisp files to it -# Windows 95 makes this harder than it should be. -# -install: - - mkdir $(INSTALL_DIR)\lisp - - $(DEL) .\same-dir.tst - - $(DEL) $(INSTALL_DIR)\lisp\same-dir.tst - echo SameDirTest > $(INSTALL_DIR)\lisp\same-dir.tst -!ifdef COPY_LISP_SOURCE - if not exist .\same-dir.tst $(CP_DIR) . $(INSTALL_DIR)\lisp -!else - if not exist .\same-dir.tst $(CP_DIR) *.elc $(INSTALL_DIR)\lisp - if not exist .\same-dir.tst $(CP) cus-load.el $(INSTALL_DIR)\lisp - if not exist .\same-dir.tst $(CP) cus-start.el $(INSTALL_DIR)\lisp - if not exist .\same-dir.tst $(CP) emacs-lisp\cl-specs.el $(INSTALL_DIR)\lisp\emacs-lisp - if not exist .\same-dir.tst $(CP) eshell\esh-maint.el $(INSTALL_DIR)\lisp\eshell - if not exist .\same-dir.tst $(CP) eshell\esh-groups.el $(INSTALL_DIR)\lisp\eshell - if not exist .\same-dir.tst $(CP) finder-inf.el $(INSTALL_DIR)\lisp - if not exist .\same-dir.tst $(CP) forms*.el $(INSTALL_DIR)\lisp - if not exist .\same-dir.tst $(CP) generic-x.el $(INSTALL_DIR)\lisp - if not exist .\same-dir.tst $(CP) patcomp.el $(INSTALL_DIR)\lisp - if not exist .\same-dir.tst $(CP) subdirs.el $(INSTALL_DIR)\lisp - if not exist .\same-dir.tst $(CP) version.el $(INSTALL_DIR)\lisp - if not exist .\same-dir.tst $(CP) mail\blessmail.el $(INSTALL_DIR)\lisp\mail - if not exist .\same-dir.tst $(CP) play\bruce.el $(INSTALL_DIR)\lisp\play - if not exist .\same-dir.tst $(CP) international\latin-*.el $(INSTALL_DIR)\lisp\international - if not exist .\same-dir.tst $(CP) international\mule-conf.el $(INSTALL_DIR)\lisp\international - - $(DEL) $(INSTALL_DIR)\lisp\same-dir.tst -!endif - -# -# Maintenance -# -clean: - - $(DEL) *~ term\*~ - - $(DEL) *.orig *.rej *.crlf - - $(DEL) emacs-lisp\*.orig emacs-lisp\*.rej emacs-lisp\*.crlf - - $(DEL) emulation\*.orig emulation\*.rej emulation\*.crlf - - $(DEL) gnus\*.orig gnus\*.rej gnus\*.crlf - - $(DEL) international\*.orig international\*.rej international\*.crlf - - $(DEL) language\*.orig language\*.rej language\*.crlf - - $(DEL) mail\*.orig mail\*.rej mail\*.crlf - - $(DEL) play\*.orig play\*.rej play\*.crlf - - $(DEL) progmodes\*.orig progmodes\*.rej progmodes\*.crlf - - $(DEL) term\*.orig term\*.rej term\*.crlf - - $(DEL) textmodes\*.orig textmodes\*.rej textmodes\*.crlf - - $(DEL_TREE) deleted - -# 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." ;; Fake modeline display as if `start-process' were run. (setq mode-line-process ":run") (force-mode-line-update) + (sit-for 0) ; Force redisplay (let ((status (call-process shell-file-name nil outbuf nil "-c" command))) (cond ((numberp status) @@ -958,6 +959,10 @@ exited abnormally with code %d\n" (concat status "\n"))) (t (compilation-handle-exit 'bizarre status status)))) + ;; Without async subprocesses, the buffer is not yet + ;; fontified, so fontify it now. + (let ((font-lock-verbose nil)) ; shut up font-lock messages + (font-lock-fontify-buffer)) (message "Executing `%s'...done" command))) (if (buffer-local-value 'compilation-scroll-output outbuf) (save-selected-window @@ -1095,10 +1100,6 @@ Runs `compilation-mode-hook' with `run-hooks' (which see)." (set (make-local-variable 'page-delimiter) compilation-page-delimiter) (compilation-setup) - ;; note that compilation-next-error-function is for interfacing - ;; with the next-error function in simple.el, and it's only - ;; coincidentally named similarly to compilation-next-error - (setq next-error-function 'compilation-next-error-function) (run-mode-hooks 'compilation-mode-hook)) (defmacro define-compilation-mode (mode name doc &rest body) @@ -1150,6 +1151,10 @@ variable exists." "Marker to the location from where the next error will be found. The global commands next/previous/first-error/goto-error use this.") +(defvar compilation-messages-start nil + "Buffer position of the beginning of the compilation messages. +If nil, use the beginning of buffer.") + ;; A function name can't be a hook, must be something with a value. (defconst compilation-turn-on-font-lock 'turn-on-font-lock) @@ -1158,8 +1163,13 @@ The global commands next/previous/first-error/goto-error use this.") Optional argument MINOR indicates this is called from `compilation-minor-mode'." (make-local-variable 'compilation-current-error) + (make-local-variable 'compilation-messages-start) (make-local-variable 'compilation-error-screen-columns) (make-local-variable 'overlay-arrow-position) + ;; Note that compilation-next-error-function is for interfacing + ;; with the next-error function in simple.el, and it's only + ;; coincidentally named similarly to compilation-next-error. + (setq next-error-function 'compilation-next-error-function) (set (make-local-variable 'font-lock-extra-managed-props) '(directory message help-echo mouse-face debug)) (set (make-local-variable 'compilation-locs) @@ -1404,16 +1414,16 @@ Use this command in a compilation log buffer. Sets the mark at point there." (let* ((columns compilation-error-screen-columns) ; buffer's local value (last 1) (loc (compilation-next-error (or n 1) nil - (or compilation-current-error (point-min)))) + (or compilation-current-error + compilation-messages-start + (point-min)))) (end-loc (nth 2 loc)) (marker (point-marker))) (setq compilation-current-error (point-marker) overlay-arrow-position (if (bolp) compilation-current-error - (save-excursion - (beginning-of-line) - (point-marker))) + (copy-marker (line-beginning-position))) loc (car loc)) ;; If loc contains no marker, no error in that file has been visited. If ;; 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." (compilation-goto-locus marker (nth 3 loc) (nth 3 end-loc)) (setcdr (nthcdr 3 loc) t))) ; Set this one as visited. +(defvar compilation-gcpro nil + "Internal variable used to keep some values from being GC'd.") +(make-variable-buffer-local 'compilation-gcpro) + (defun compilation-fake-loc (marker file &optional line col) "Preassociate MARKER with FILE. FILE should be ABSOLUTE-FILENAME or (RELATIVE-FILENAME . DIRNAME). @@ -1466,6 +1480,11 @@ call this several times, once each for the last line of one region and the first line of the next region." (or (consp file) (setq file (list file))) (setq file (compilation-get-file-structure file)) + ;; Between the current call to compilation-fake-loc and the first occurrence + ;; of an error message referring to `file', the data is only kept is the + ;; weak hash-table compilation-locs, so we need to prevent this entry + ;; in compilation-locs from being GC'd away. --Stef + (push file compilation-gcpro) (let ((loc (compilation-assq (or line 1) (cdr file)))) (setq loc (compilation-assq col loc)) (if (cdr loc) @@ -1715,10 +1734,12 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)." (goto-char limit) nil) +;; Beware: this is not only compatiblity code. New code stil uses it. --Stef (defun compilation-forget-errors () ;; In case we hit the same file/line specs, we want to recompute a new ;; marker for them, so flush our cache. (setq compilation-locs (make-hash-table :test 'equal :weakness 'value)) + (setq compilation-gcpro nil) ;; FIXME: the old code reset the directory-stack, so maybe we should ;; put a `directory change' marker of some sort, but where? -stef ;; @@ -1730,9 +1751,19 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME)." ;; something equivalent to point-max. So we speculatively move ;; compilation-current-error to point-max (since the external package ;; won't know that it should do it). --stef - (setq compilation-current-error (point-max))) + (setq compilation-current-error nil) + (let* ((proc (get-buffer-process (current-buffer))) + (mark (if proc (process-mark proc))) + (pos (or mark (point-max)))) + (setq compilation-messages-start + ;; In the future, ignore the text already present in the buffer. + ;; Since many process filter functions insert before markers, + ;; we need to put ours just before the insertion point rather + ;; than at the insertion point. If that's not possible, then + ;; don't use a marker. --Stef + (if (> pos (point-min)) (copy-marker (1- pos)) pos)))) (provide 'compile) -;;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c +;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c ;;; 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." (gdb-enqueue-input (list (concat "server interpreter mi \"-var-create - * " expr "\"\n") `(lambda () (gdb-var-create-handler ,expr)))))) - (select-window (get-buffer-window gud-comint-buffer))) + (select-window (get-buffer-window gud-comint-buffer 'visible))) (defun gdb-goto-info () + "Go to Emacs info node: GDB Graphical Interface." (interactive) (select-frame (make-frame)) (require 'info) @@ -1117,7 +1118,7 @@ static char *magick[] = { (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) (defun gdb-mouse-toggle-breakpoint (event) - "Toggle breakpoint with mouse click in left margin." + "Toggle breakpoint in left fringe/margin with mouse click" (interactive "e") (mouse-minibuffer-check event) (let ((posn (event-end event))) @@ -1137,6 +1138,7 @@ static char *magick[] = { (concat "*breakpoints of " (gdb-get-target-string) "*"))) (defun gdb-display-breakpoints-buffer () + "Display status of user-settable breakpoints." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer))) @@ -1149,6 +1151,7 @@ static char *magick[] = { (minibuffer . nil))) (defun gdb-frame-breakpoints-buffer () + "Display status of user-settable breakpoints in a new frame." (interactive) (select-frame (make-frame gdb-frame-parameters)) (switch-to-buffer (gdb-get-create-buffer 'gdb-breakpoints-buffer)) @@ -1205,8 +1208,7 @@ static char *magick[] = { (list (concat "server delete " (match-string 1) "\n") 'ignore)))) (defun gdb-goto-breakpoint () - "Display the file in the source buffer at the breakpoint specified on the -current line." + "Display the breakpoint location specified at current line." (interactive) (save-excursion (beginning-of-line 1) @@ -1216,14 +1218,16 @@ current line." (let ((line (match-string 2)) (file (match-string 1))) (save-selected-window - (gdb-display-buffer (find-file-noselect - (if (file-exists-p file) - file - (expand-file-name file gdb-cdir)))) - (goto-line (string-to-number line)))))) + (let* ((buf (find-file-noselect (if (file-exists-p file) + file + (expand-file-name file gdb-cdir)))) + (window (gdb-display-buffer buf))) + (with-current-buffer buf + (goto-line (string-to-number line)) + (set-window-point window (point)))))))) (defun gdb-mouse-goto-breakpoint (event) - "Display the file in the source buffer at the selected breakpoint." + "Display the breakpoint location that you click on." (interactive "e") (mouse-set-point event) (gdb-goto-breakpoint)) @@ -1266,11 +1270,13 @@ current line." (concat "*stack frames of " (gdb-get-target-string) "*"))) (defun gdb-display-stack-buffer () + "Display backtrace of current stack." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-stack-buffer))) (defun gdb-frame-stack-buffer () + "Display backtrace of current stack in a new frame." (interactive) (select-frame (make-frame gdb-frame-parameters)) (switch-to-buffer (gdb-get-create-buffer 'gdb-stack-buffer)) @@ -1301,16 +1307,14 @@ current line." n))) (defun gdb-frames-select () - "Make the frame on the current line become the current frame and display the -source in the source buffer." + "Select the frame and display the relevant source." (interactive) (gdb-enqueue-input (list (concat "server frame " (gdb-get-frame-number) "\n") 'ignore)) (gud-display-frame)) (defun gdb-frames-mouse-select (event) - "Make the selected frame become the current frame and display the source in -the source buffer." + "Select the frame you click on and display the relevant source." (interactive "e") (mouse-set-point event) (gdb-frames-select)) @@ -1343,11 +1347,13 @@ the source buffer." (concat "*threads of " (gdb-get-target-string) "*"))) (defun gdb-display-threads-buffer () + "Display IDs of currently known threads." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-threads-buffer))) (defun gdb-frame-threads-buffer () + "Display IDs of currently known threads in a new frame." (interactive) (select-frame (make-frame gdb-frame-parameters)) (switch-to-buffer (gdb-get-create-buffer 'gdb-threads-buffer)) @@ -1376,16 +1382,14 @@ the source buffer." (match-string-no-properties 1))) (defun gdb-threads-select () - "Make the thread on the current line become the current thread and display the -source in the source buffer." + "Select the thread and display the relevant source." (interactive) (gdb-enqueue-input (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore)) (gud-display-frame)) (defun gdb-threads-mouse-select (event) - "Make the selected frame become the current frame and display the source in -the source buffer." + "Select the thread you click on and display the relevant source." (interactive "e") (mouse-set-point event) (gdb-threads-select)) @@ -1425,11 +1429,13 @@ the source buffer." (concat "*registers of " (gdb-get-target-string) "*"))) (defun gdb-display-registers-buffer () + "Display integer register contents." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-registers-buffer))) (defun gdb-frame-registers-buffer () + "Display integer register contents in a new frame." (interactive) (select-frame (make-frame gdb-frame-parameters)) (switch-to-buffer (gdb-get-create-buffer 'gdb-registers-buffer)) @@ -1497,11 +1503,13 @@ the source buffer." (concat "*locals of " (gdb-get-target-string) "*"))) (defun gdb-display-locals-buffer () + "Display local variables of current stack and their values." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-locals-buffer))) (defun gdb-frame-locals-buffer () + "Display local variables of current stack and their values in a new frame." (interactive) (select-frame (make-frame gdb-frame-parameters)) (switch-to-buffer (gdb-get-create-buffer 'gdb-locals-buffer)) @@ -1524,7 +1532,7 @@ the source buffer." #'(lambda (win) (if (eq gud-comint-buffer (window-buffer win)) (set-window-dedicated-p win t)))) - (setq answer (get-buffer-window buf)) + (setq answer (get-buffer-window buf 'visible)) (if (not answer) (let ((window (get-lru-window 'visible))) (if window @@ -1548,7 +1556,7 @@ the source buffer." (if (eq gdb-selected-view 'source) (gdb-display-buffer buffer) (gdb-display-buffer (gdb-get-buffer 'gdb-assembler-buffer))) - (get-buffer-window buffer)) + (get-buffer-window buffer 'visible)) ;;; Shared keymap initialization: @@ -1557,11 +1565,11 @@ the source buffer." (define-key gud-menu-map [frames] `(menu-item "GDB-Frames" ,menu :visible (eq gud-minor-mode 'gdba))) (define-key menu [gdb] '("Gdb" . gdb-frame-gdb-buffer)) - (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) + (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) (define-key menu [registers] '("Registers" . gdb-frame-registers-buffer)) + (define-key menu [locals] '("Locals" . gdb-frame-locals-buffer)) (define-key menu [frames] '("Stack" . gdb-frame-stack-buffer)) (define-key menu [breakpoints] '("Breakpoints" . gdb-frame-breakpoints-buffer)) - (define-key menu [threads] '("Threads" . gdb-frame-threads-buffer)) ; (define-key menu [assembler] '("Machine" . gdb-frame-assembler-buffer)) ) @@ -1569,11 +1577,11 @@ the source buffer." (define-key gud-menu-map [displays] `(menu-item "GDB-Windows" ,menu :visible (eq gud-minor-mode 'gdba))) (define-key menu [gdb] '("Gdb" . gdb-display-gdb-buffer)) - (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) + (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) (define-key menu [registers] '("Registers" . gdb-display-registers-buffer)) + (define-key menu [locals] '("Locals" . gdb-display-locals-buffer)) (define-key menu [frames] '("Stack" . gdb-display-stack-buffer)) (define-key menu [breakpoints] '("Breakpoints" . gdb-display-breakpoints-buffer)) - (define-key menu [threads] '("Threads" . gdb-display-threads-buffer)) ; (define-key menu [assembler] '("Machine" . gdb-display-assembler-buffer)) ) @@ -1601,12 +1609,14 @@ the source buffer." "Display locals, stack and breakpoint information"))) (defun gdb-frame-gdb-buffer () + "Display GUD buffer in a new frame." (interactive) (select-frame (make-frame gdb-frame-parameters)) (switch-to-buffer (gdb-get-create-buffer 'gdba)) (set-window-dedicated-p (selected-window) t)) (defun gdb-display-gdb-buffer () + "Display GUD buffer." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdba))) @@ -1614,6 +1624,7 @@ the source buffer." (defvar gdb-main-file nil "Source file from which program execution begins.") (defun gdb-view-source-function () + "Select source view." (interactive) (if gdb-view-source (gdb-display-buffer @@ -1623,6 +1634,7 @@ the source buffer." (setq gdb-selected-view 'source)) (defun gdb-view-assembler() + "Select disassembly view." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer)) (gdb-invalidate-assembler) @@ -1805,11 +1817,10 @@ BUFFER nil or omitted means use the current buffer." (when (< left-margin-width 2) (save-current-buffer (setq left-margin-width 2) - (if (get-buffer-window (current-buffer)) - (set-window-margins (get-buffer-window - (current-buffer)) - left-margin-width - right-margin-width)))) + (if (get-buffer-window (current-buffer) 'visible) + (set-window-margins + (get-buffer-window (current-buffer) 'visible) + left-margin-width right-margin-width)))) (put-image (if enabled (or breakpoint-enabled-icon @@ -1833,11 +1844,10 @@ BUFFER nil or omitted means use the current buffer." (when (< left-margin-width 2) (save-current-buffer (setq left-margin-width 2) - (if (get-buffer-window (current-buffer)) - (set-window-margins (get-buffer-window - (current-buffer)) - left-margin-width - right-margin-width)))) + (if (get-buffer-window (current-buffer) 'visible) + (set-window-margins + (get-buffer-window (current-buffer) 'visible) + left-margin-width right-margin-width)))) (gdb-put-string (if enabled "B" "b") (1+ start))))) (defun gdb-remove-breakpoint-icons (start end &optional remove-margin) @@ -1846,11 +1856,10 @@ BUFFER nil or omitted means use the current buffer." (remove-images start end)) (when remove-margin (setq left-margin-width 0) - (if (get-buffer-window (current-buffer)) - (set-window-margins (get-buffer-window - (current-buffer)) - left-margin-width - right-margin-width)))) + (if (get-buffer-window (current-buffer) 'visible) + (set-window-margins + (get-buffer-window (current-buffer) 'visible) + left-margin-width right-margin-width)))) ;; @@ -1901,7 +1910,7 @@ BUFFER nil or omitted means use the current buffer." (if (re-search-forward address nil t) (gdb-put-breakpoint-icon (eq flag ?y)))))))) (if (not (equal gdb-current-address "main")) - (set-window-point (get-buffer-window buffer) pos)))) + (set-window-point (get-buffer-window buffer 'visible) pos)))) (defvar gdb-assembler-mode-map (let ((map (make-sparse-keymap))) @@ -1927,11 +1936,13 @@ BUFFER nil or omitted means use the current buffer." (concat "*Machine Code " (gdb-get-target-string) "*"))) (defun gdb-display-assembler-buffer () + "Display disassembly view." (interactive) (gdb-display-buffer (gdb-get-create-buffer 'gdb-assembler-buffer))) (defun gdb-frame-assembler-buffer () + "Display disassembly view in a new frame." (interactive) (select-frame (make-frame gdb-frame-parameters)) (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 @@ ;; I've installed a minor mode to do the job properly in Emacs 22. ;; Other things seem more natural or canonical here, e.g. the ;; {beginning,end}-of-defun implementation dealing with nested -;; definitions, and the inferior mode following `cmuscheme'. (The -;; inferior mode should be able to find the source of errors from -;; `python-send-region' & al via `compilation-minor-mode', but I can't -;; make that work with the current (March '04) compile.el.) -;; Successive TABs cycle between possible indentations for the line. +;; definitions, and the inferior mode following `cmuscheme'. The +;; inferior mode can find the source of errors from +;; `python-send-region' & al via `compilation-minor-mode'. Successive +;; TABs cycle between possible indentations for the line. There is +;; symbol completion using lookup in Python. ;; Even where it has similar facilities, this is incompatible with ;; python-mode.el in various respects. For instance, various key ;; bindings are changed to obey Emacs conventions, and things like ;; marking blocks and `beginning-of-defun' behave differently. -;; TODO: See various Fixmes below. It should be possible to arrange -;; some sort of completion using the inferior interpreter. +;; TODO: See various Fixmes below. ;;; Code: @@ -203,6 +202,8 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)." (define-key map "\C-c\C-z" 'python-switch-to-python) (define-key map "\C-c\C-m" 'python-load-file) (define-key map "\C-c\C-l" 'python-load-file) ; a la cmuscheme + (substitute-key-definition 'complete-symbol 'python-complete-symbol + map global-map) ;; Fixme: Add :help to menu. (easy-menu-define python-menu map "Python Mode menu" '("Python" @@ -261,9 +262,7 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)." ;;;; Utility stuff (defsubst python-in-string/comment () - "Return non-nil if point is in a Python literal (a comment or string). -Optional argument LIM indicates the beginning of the containing form, -i.e. the limit on how far back to scan." + "Return non-nil if point is in a Python literal (a comment or string)." (syntax-ppss-context (syntax-ppss))) (defconst python-space-backslash-table @@ -300,14 +299,17 @@ comments and strings, or that the bracket/paren nesting depth is nonzero." (defun python-comment-line-p () "Return non-nil if current line has only a comment or is blank." (save-excursion - (back-to-indentation) - (looking-at (rx (or (syntax comment-start) line-end))))) + (end-of-line) + ;; FIXME: This looks wrong because it returns nil for empty lines. --Stef + (when (eq 'comment (syntax-ppss-context (syntax-ppss))) + (back-to-indentation) + (looking-at (rx (or (syntax comment-start) line-end)))))) (defun python-beginning-of-string () "Go to beginning of string around point. Do nothing if not in string." (let ((state (syntax-ppss))) - (when (nth 3 state) + (when (eq 'string (syntax-ppss-context state)) (goto-char (nth 8 state))))) (defun python-open-block-statement-p (&optional bos) @@ -383,7 +385,8 @@ Otherwise indent them to column zero." (defcustom python-honour-comment-indentation nil "Non-nil means indent relative to preceding comment line. Only do this for comments where the leading comment character is followed -by space." +by space. This doesn't apply to comment lines, which are always indented +in lines with preceding comments." :type 'boolean :group 'python) @@ -513,6 +516,16 @@ Set `python-indent' locally to the value guessed." (- python-indent))) 0))))))))) +(defun python-comment-indent () + "`comment-indent-function' for Python." + ;; If previous non-blank line was a comment, use its indentation. + ;; FIXME: This seems unnecessary since the default code delegates to + ;; indent-according-to-mode. --Stef + (unless (bobp) + (save-excursion + (forward-comment -1) + (if (eq ?# (char-after)) (current-column))))) + ;;;; Cycling through the possible indentations with successive TABs. ;; 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." (point)))) (defun python-indentation-levels () - "Return a list of possible indentations for this statement. + "Return a list of possible indentations for this line. Includes the default indentation and those which would close all -enclosing blocks." +enclosing blocks. Assumes the line has already been indented per +`python-indent-line'. Elements of the list are actually pairs: +\(INDENTATION . TEXT), where TEXT is the initial text of the +corresponding block opening (or nil)." (save-excursion - (let ((levels (list (cons (current-indentation) nil)))) + (let ((levels (list (cons (current-indentation) + (save-excursion + (if (python-beginning-of-block) + (python-initial-text))))))) ;; Only one possibility if we immediately follow a block open or ;; are in a continuation line. (unless (or (python-continuation-line-p) @@ -567,8 +586,7 @@ enclosing blocks." (if (> (- (point-max) pos) (point)) (goto-char (- (point-max) pos)))))) -;; Fixme: Is the arg necessary? -(defun python-indent-line (&optional arg) +(defun python-indent-line () "Indent current line as Python code. When invoked via `indent-for-tab-command', cycle through possible indentations 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." (beginning-of-line) (delete-horizontal-space) (indent-to (car (nth python-indent-index python-indent-list))) - (let ((text (cdr (nth python-indent-index - python-indent-list)))) - (if text (message "Closes: %s" text))))) + (if (python-block-end-p) + (let ((text (cdr (nth python-indent-index + python-indent-list)))) + (if text + (message "Closes: %s" text)))))) (python-indent-line-1) (setq python-indent-list (python-indentation-levels) python-indent-list-length (length python-indent-list) python-indent-index (1- python-indent-list-length))))) + +(defun python-block-end-p () + "Non-nil if this is a line in a statement closing a block, +or a blank line indented to where it would close a block." + (and (not (python-comment-line-p)) + (or (python-close-block-statement-p t) + (< (current-indentation) + (save-excursion + (python-previous-statement) + (current-indentation)))))) + +;; Fixme: Define an indent-region-function. It should probably leave +;; lines alone if the indentation is already at one of the allowed +;; levels. Otherwise, M-C-\ typically keeps indenting more deeply +;; down a function. ;;;; Movement. @@ -628,8 +663,7 @@ start of buffer." "`end-of-defun-function' for Python. Finds end of innermost nested class or method definition." (let ((orig (point)) - (pattern (rx (and line-start (0+ space) - (or "def" "class") space)))) + (pattern (rx (and line-start (0+ space) (or "def" "class") space)))) ;; Go to start of current block and check whether it's at top ;; level. If it is, and not a block start, look forward for ;; definition statement. @@ -914,13 +948,20 @@ See `python-check-command' for the default." (file-name-nondirectory name)))))))) (setq python-saved-check-command command) (save-some-buffers (not compilation-ask-about-save) nil) - (compilation-start command)) + (let ((compilation-error-regexp-alist + (cons '("(\\([^,]+\\), line \\([0-9]+\\))" 1 2) + compilation-error-regexp-alist))) + (compilation-start command))) ;;;; Inferior mode stuff (following cmuscheme). +;; Fixme: Make sure we can work with IPython. + (defcustom python-python-command "python" "*Shell command to run Python interpreter. -Any arguments can't contain whitespace." +Any arguments can't contain whitespace. +Note that IPython may not work properly; it must at least be used with the +`-cl' flag, i.e. use `ipython -cl'." :group 'python :type 'string) @@ -970,12 +1011,31 @@ et al.") ) (defconst python-compilation-regexp-alist + ;; FIXME: maybe these should move to compilation-error-regexp-alist-alist. `((,(rx (and line-start (1+ (any " \t")) "File \"" (group (1+ (not (any "\"<")))) ; avoid `<stdin>' &c "\", line " (group (1+ digit)))) - 1 python-compilation-line-number)) + 1 2) + (,(rx (and " in file " (group (1+ not-newline)) " on line " + (group (1+ digit)))) + 1 2)) "`compilation-error-regexp-alist' for inferior Python.") +(defvar inferior-python-mode-map + (let ((map (make-sparse-keymap))) + ;; This will inherit from comint-mode-map. + (define-key map "\C-c\C-l" 'python-load-file) + (define-key map "\C-c\C-z" 'python-switch-to-python) ;What for? --Stef + (define-key map "\C-c\C-v" 'python-check) + ;; Note that we _can_ still use these commands which send to the + ;; Python process even at the prompt iff we have a normal prompt, + ;; i.e. '>>> ' and not '... '. See the comment before + ;; python-send-region. Fixme: uncomment these if we address that. + + ;; (define-key map [(meta ?\t)] 'python-complete-symbol) + ;; (define-key map "\C-c\C-f" 'python-describe-symbol) + map)) + ;; Fixme: This should inherit some stuff from python-mode, but I'm not ;; sure how much: at least some keybindings, like C-c C-f; syntax?; ;; font-locking, e.g. for triple-quoted strings? @@ -999,15 +1059,13 @@ For running multiple processes in multiple buffers, see `python-buffer'. :group 'python (set-syntax-table python-mode-syntax-table) (setq mode-line-process '(":%s")) - ;; Fixme: Maybe install some python-mode bindings too. - (define-key inferior-python-mode-map "\C-c\C-l" 'python-load-file) - (define-key inferior-python-mode-map "\C-c\C-z" 'python-switch-to-python) - (add-hook 'comint-input-filter-functions 'python-input-filter nil t) + (set (make-local-variable 'comint-input-filter) 'python-input-filter) (add-hook 'comint-preoutput-filter-functions #'python-preoutput-filter nil t) ;; Still required by `comint-redirect-send-command', for instance ;; (and we need to match things like `>>> ... >>> '): - (set (make-local-variable 'comint-prompt-regexp) "^\\([>.]\\{3\\} \\)+") + (set (make-local-variable 'comint-prompt-regexp) + (rx (and line-start (1+ (and (repeat 3 (any ">.")) ?\ ))))) (set (make-local-variable 'compilation-error-regexp-alist) python-compilation-regexp-alist) (compilation-shell-minor-mode 1)) @@ -1018,15 +1076,9 @@ Default ignores all inputs of 0, 1, or 2 non-blank characters." :type 'regexp :group 'python) -(defvar python-orig-start nil - "Marker to the start of the region passed to the inferior Python. -It can also be a filename.") - (defun python-input-filter (str) "`comint-input-filter' function for inferior Python. -Don't save anything for STR matching `inferior-python-filter-regexp'. -Also resets variables for adjusting error messages." - (setq python-orig-start nil) +Don't save anything for STR matching `inferior-python-filter-regexp'." (not (string-match inferior-python-filter-regexp str))) ;; Fixme: Loses with quoted whitespace. @@ -1039,25 +1091,8 @@ Also resets variables for adjusting error messages." (t (let ((pos (string-match "[^ \t]" string))) (if pos (python-args-to-list (substring string pos)))))))) -(defun python-compilation-line-number (file col) - "Return error descriptor of error found for FILE, column COL. -Used as line-number hook function in `python-compilation-regexp-alist'." - (let ((line (string-to-number (match-string 2)))) - (cons (point-marker) - (if (and (markerp python-orig-start) - (marker-buffer python-orig-start)) - (let ((start python-orig-start)) - (with-current-buffer (marker-buffer python-orig-start) - (goto-char start) - (forward-line (1- line)) - (point-marker))) - (list (if (stringp python-orig-start) - (list python-orig-start default-directory) - file) - line col))))) - (defvar python-preoutput-result nil - "Data from output line last `_emacs_out' line seen by the preoutput filter.") + "Data from last `_emacs_out' line seen by the preoutput filter.") (defvar python-preoutput-continuation nil "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'." ;; `python-preoutput-continuation' if we get it. (defun python-preoutput-filter (s) "`comint-preoutput-filter-functions' function: ignore prompts not at bol." - (cond ((and (string-match "\\`[.>]\\{3\\} \\'" s) + (cond ((and (string-match (rx (and string-start (repeat 3 (any ".>")) + " " string-end)) + s) (/= (let ((inhibit-field-text-motion t)) (line-beginning-position)) (point))) @@ -1089,10 +1126,10 @@ Used as line-number hook function in `python-compilation-regexp-alist'." CMD is the Python command to run. NOSHOW non-nil means don't show the buffer automatically. If there is a process already running in `*Python*', switch to -that buffer. Interactively a prefix arg, allows you to edit the initial -command line (default is the value of `python-command'); `-i' etc. args -will be added to this as appropriate. Runs the hooks -`inferior-python-mode-hook' (after the `comint-mode-hook' is run). +that buffer. Interactively, a prefix arg allows you to edit the initial +command line (default is `python-command'); `-i' etc. args will be added +to this as appropriate. Runs the hook `inferior-python-mode-hook' +\(after the `comint-mode-hook' is run). \(Type \\[describe-mode] in the process buffer for a list of commands.)" (interactive (list (if current-prefix-arg (read-string "Run Python: " python-command) @@ -1102,47 +1139,34 @@ will be added to this as appropriate. Runs the hooks ;; Fixme: Consider making `python-buffer' buffer-local as a buffer ;; (not a name) in Python buffers from which `run-python' &c is ;; invoked. Would support multiple processes better. - (unless (comint-check-proc "*Python*") - (let ((cmdlist (append (python-args-to-list cmd) '("-i")))) + (unless (comint-check-proc python-buffer) + (let ((cmdlist (append (python-args-to-list cmd) '("-i"))) + (process-environment ; to import emacs.py + (push (concat "PYTHONPATH=" data-directory) + process-environment))) (set-buffer (apply 'make-comint "Python" (car cmdlist) nil - (cdr cmdlist)))) + (cdr cmdlist))) + (setq python-buffer "*Python*")) (inferior-python-mode) ;; Load function defintions we need. ;; Before the preoutput function was used, this was done via -c in ;; cmdlist, but that loses the banner and doesn't run the startup - ;; file. - (python-send-string "\ -def _emacs_execfile (file): # execute file and remove it - from os import remove - try: execfile (file, globals (), globals ()) - finally: remove (file) - -def _emacs_args (name): # get arglist of name for eldoc &c - import inspect - parts = name.split ('.') - if len (parts) > 1: - try: exec 'import ' + parts[0] - except: return None - try: exec 'func='+name # lose if name is keyword or undefined - except: return None - if inspect.isbuiltin (func): - doc = func.__doc__ - if doc.find (' ->') != -1: - print '_emacs_out', doc.split (' ->')[0] - elif doc.find ('\\n') != -1: - print '_emacs_out', doc.split ('\\n')[0] - return None - if inspect.ismethod (func): func = func.im_func - if not inspect.isfunction (func): - return None - (args, varargs, varkw, defaults) = inspect.getargspec (func) - print '_emacs_out', func.__name__+inspect.formatargspec (args, varargs, varkw, defaults) - -print '_emacs_ok'")) - (unless noshow (pop-to-buffer (setq python-buffer "*Python*")))) + ;; file. The code might be inline here, but there's enough that it + ;; seems worth putting in a separate file, and it's probably cleaner + ;; to put it in a module. + (python-send-string "import emacs")) + (unless noshow (pop-to-buffer python-buffer))) + +;; Fixme: We typically lose if the inferior isn't in the normal REPL, +;; e.g. prompt is `help> '. Probably raise an error if the form of +;; the prompt is unexpected; actually, it needs to be `>>> ', not +;; `... ', i.e. we're not inputting a block &c. However, this may not +;; be the place to do it, e.g. we might actually want to send commands +;; having set up such a state. (defun python-send-command (command) "Like `python-send-string' but resets `compilation-minor-mode'." + (goto-char (point-max)) (let ((end (marker-position (process-mark (python-proc))))) (compilation-forget-errors) (python-send-string command) @@ -1154,35 +1178,37 @@ print '_emacs_ok'")) ;; The region is evaluated from a temporary file. This avoids ;; problems with blank lines, which have different semantics ;; interactively and in files. It also saves the inferior process - ;; buffer filling up with interpreter prompts. We need a function - ;; to remove the temporary file when it has been evaluated, which - ;; unfortunately means using a not-quite pristine interpreter - ;; initially. Unfortunately we also get tracebacks which look like: - ;; - ;; >>> Traceback (most recent call last): - ;; File "<stdin>", line 1, in ? - ;; File "<string>", line 4, in _emacs_execfile - ;; File "/tmp/py7734RSB", line 11 + ;; buffer filling up with interpreter prompts. We need a Python + ;; function to remove the temporary file when it has been evaluated + ;; (though we could probably do it in Lisp with a Comint output + ;; filter). This function also catches exceptions and truncates + ;; tracebacks not to mention the frame of the function itself. ;; ;; The compilation-minor-mode parsing takes care of relating the - ;; reference to the temporary file to the source. Fixme: - ;; comint-filter the first two lines of the traceback? + ;; reference to the temporary file to the source. + ;; + ;; Fixme: Write a `coding' header to the temp file if the region is + ;; non-ASCII. (interactive "r") (let* ((f (make-temp-file "py")) - (command (format "_emacs_execfile(%S)" f)) + (command (format "emacs.eexecfile(%S)" f)) (orig-start (copy-marker start))) - (if (save-excursion - (goto-char start) - (/= 0 (current-indentation))) ; need dummy block - (write-region "if True:\n" nil f nil 'nomsg)) + (when (save-excursion + (goto-char start) + (/= 0 (current-indentation))) ; need dummy block + (save-excursion + (goto-char orig-start) + ;; Wrong if we had indented code at buffer start. + (set-marker orig-start (line-beginning-position 0))) + (write-region "if True:\n" nil f nil 'nomsg)) (write-region start end f t 'nomsg) - (when python-buffer + (let ((proc (python-proc))) ;Make sure we're running a process. (with-current-buffer python-buffer - (set (make-local-variable 'python-orig-start) orig-start) - (let ((comint-input-filter-functions - ;; Don't reset python-orig-start. - (remq 'python-input-filter comint-input-filter-functions))) - (python-send-command command)))))) + (python-send-command command) + ;; Tell compile.el to redirect error locations in file `f' to + ;; positions past marker `orig-start'. It has to be done *after* + ;; python-send-command's call to compilation-forget-errors. + (compilation-fake-loc orig-start f))))) (defun python-send-string (string) "Evaluate STRING in inferior Python process." @@ -1195,6 +1221,8 @@ print '_emacs_ok'")) (interactive) (python-send-region (point-min) (point-max))) +;; Fixme: Try to define the function or class within the relevant +;; module, not just at top level. (defun python-send-defun () "Send the current defun (class or method) to the inferior Python process." (interactive) @@ -1241,11 +1269,11 @@ function location information for debugging, and supports users of module-qualified names." (interactive (comint-get-source "Load Python file: " python-prev-dir/file python-source-modes - t)) ; because execfile needs exact name - (comint-check-source file-name) ; Check to see if buffer needs saved. + t)) ; because execfile needs exact name + (comint-check-source file-name) ; Check to see if buffer needs saving. (setq python-prev-dir/file (cons (file-name-directory file-name) (file-name-nondirectory file-name))) - (when python-buffer + (let ((proc (python-proc))) ;Make sure we have a process. (with-current-buffer python-buffer ;; Fixme: I'm not convinced by this logic from python-mode.el. (python-send-command @@ -1253,19 +1281,22 @@ module-qualified names." ;; Fixme: make sure the directory is in the path list (let ((module (file-name-sans-extension (file-name-nondirectory file-name)))) - (format "\ -if globals().has_key(%S): reload(%s) -else: import %s -" module module module)) - (format "execfile('%s')" file-name)))))) + (format "emacs.eimport(%S,%S)" + module (file-name-directory file-name))) + (format "execfile(%S)" file-name))) + (message "%s loaded" file-name)))) -;; Fixme: Should this start a process if there isn't one? (Unlike cmuscheme.) +;; Fixme: If we need to start the process, wait until we've got the OK +;; from the startup. (defun python-proc () - "Return the current Python process. See variable `python-buffer'." - (let ((proc (get-buffer-process (if (eq major-mode 'inferior-python-mode) - (current-buffer) - python-buffer)))) - (or proc (error "No current process. See variable `python-buffer'")))) + "Return the current Python process. +See variable `python-buffer'. Starts a new process if necessary." + (or (if python-buffer + (get-buffer-process (if (eq major-mode 'inferior-python-mode) + (current-buffer) + python-buffer))) + (progn (run-python nil t) + (python-proc)))) ;;;; Context-sensitive help. @@ -1277,33 +1308,46 @@ else: import %s "Syntax table giving `.' symbol syntax. Otherwise inherits from `python-mode-syntax-table'.") +(defvar view-return-to-alist) + ;; Fixme: Should this actually be used instead of info-look, i.e. be -;; bound to C-h S? +;; bound to C-h S? Can we use other pydoc stuff before python 2.2? (defun python-describe-symbol (symbol) - "Get help on SYMBOL using `pydoc'. -Interactively, prompt for symbol." - ;; Note that we do this in the inferior process, not a separate one to + "Get help on SYMBOL using `help'. +Interactively, prompt for symbol. + +Symbol may be anything recognized by the interpreter's `help' command -- +e.g. `CALLS' -- not just variables in scope. +This only works for Python version 2.2 or newer since earlier interpreters +don't support `help'." + ;; Note that we do this in the inferior process, not a separate one, to ;; ensure the environment is appropriate. (interactive (let ((symbol (with-syntax-table python-dotty-syntax-table (current-word))) - (enable-recursive-minibuffers t) - val) - (setq val (read-string (if symbol - (format "Describe symbol (default %s): " - symbol) - "Describe symbol: ") - nil nil symbol)) - (list (or val symbol)))) + (enable-recursive-minibuffers t)) + (list (read-string (if symbol + (format "Describe symbol (default %s): " symbol) + "Describe symbol: ") + nil nil symbol)))) (if (equal symbol "") (error "No symbol")) (let* ((func `(lambda () - (comint-redirect-send-command (format "help(%S)\n" ,symbol) + (comint-redirect-send-command (format "emacs.ehelp(%S)\n" + ,symbol) "*Help*" nil)))) ;; Ensure we have a suitable help buffer. - (let (temp-buffer-show-hook) ; avoid xref stuff - (with-output-to-temp-buffer "*Help*" + ;; Fixme: Maybe process `Related help topics' a la help xrefs and + ;; allow C-c C-f in help buffer. + (let ((temp-buffer-show-hook ; avoid xref stuff + (lambda () + (toggle-read-only 1) + (setq view-return-to-alist + (list (cons (selected-window) help-return-method)))))) + (help-setup-xref (list 'python-describe-symbol symbol)) + (with-output-to-temp-buffer (help-buffer) (with-current-buffer standard-output - (set (make-local-variable 'comint-redirect-subvert-readonly) t)))) + (set (make-local-variable 'comint-redirect-subvert-readonly) t) + (print-help-return-message)))) (if (and python-buffer (get-buffer python-buffer)) (with-current-buffer python-buffer (funcall func)) @@ -1312,6 +1356,15 @@ Interactively, prompt for symbol." (add-to-list 'debug-ignored-errors "^No symbol") +(defun python-send-receive (string) + "Send STRING to inferior Python (if any) and return result. +The result is what follows `_emacs_out' in the output (or nil)." + (let ((proc (python-proc))) + (python-send-string string) + (setq python-preoutput-result nil) + (accept-process-output proc 5) + python-preoutput-result)) + ;; Fixme: try to make it work with point in the arglist. Also, is ;; there anything reasonable we can do with random methods? ;; (Currently only works with functions.) @@ -1320,14 +1373,9 @@ Interactively, prompt for symbol." Only works when point is in a function name, not its arglist, for instance. Assumes an inferior Python is running." (let ((symbol (with-syntax-table python-dotty-syntax-table - (current-word))) - (proc (and python-buffer (python-proc)))) - (when (and proc symbol) - (python-send-string - (format "_emacs_args(%S)" symbol)) - (setq python-preoutput-result nil) - (accept-process-output proc 1) - python-preoutput-result))) + (current-word)))) + (when symbol + (python-send-receive (format "emacs.eargs(%S)" symbol))))) ;;;; Info-look functionality. @@ -1530,11 +1578,97 @@ Uses `python-beginning-of-block', `python-end-of-block'." (python-end-of-block) (exchange-point-and-mark)) +;;;; Completion. + +(defun python-symbol-completions (symbol) + "Return a list of completions of the string SYMBOL from Python process. +The list is sorted." + (when symbol + (let ((completions + (condition-case () + (car (read-from-string (python-send-receive + (format "emacs.complete(%S)" symbol)))) + (error nil)))) + (sort + ;; We can get duplicates from the above -- don't know why. + (delete-dups completions) + #'string<)))) + +(defun python-partial-symbol () + "Return the partial symbol before point (for completion)." + (let ((end (point)) + (start (save-excursion + (and (re-search-backward + (rx (and (or buffer-start (regexp "[^[:alnum:]._]")) + (group (1+ (regexp "[[:alnum:]._]"))) + point)) + nil t) + (match-beginning 1))))) + (if start (buffer-substring-no-properties start end)))) + +;; Fixme: We should have an abstraction of this sort of thing in the +;; core. +(defun python-complete-symbol () + "Perform completion on the Python symbol preceding point. +Repeating the command scrolls the completion window." + (interactive) + (let ((window (get-buffer-window "*Completions*"))) + (if (and (eq last-command this-command) + window (window-live-p window) (window-buffer window) + (buffer-name (window-buffer window))) + (with-current-buffer (window-buffer window) + (if (pos-visible-in-window-p (point-max) window) + (set-window-start window (point-min)) + (save-selected-window + (select-window window) + (scroll-up)))) + ;; Do completion. + (let* ((end (point)) + (symbol (python-partial-symbol)) + (completions (python-symbol-completions symbol)) + (completion (if completions + (try-completion symbol completions)))) + (when symbol + (cond ((eq completion t)) + ((null completion) + (message "Can't find completion for \"%s\"" symbol) + (ding)) + ((not (string= symbol completion)) + (delete-region (- end (length symbol)) end) + (insert completion)) + (t + (message "Making completion list...") + (with-output-to-temp-buffer "*Completions*" + (display-completion-list completions)) + (message "Making completion list...%s" "done")))))))) + +(eval-when-compile (require 'hippie-exp)) + +(defun python-try-complete (old) + "Completion function for Python for use with `hippie-expand'." + (when (eq major-mode 'python-mode) ; though we only add it locally + (unless old + (let ((symbol (python-partial-symbol))) + (he-init-string (- (point) (length symbol)) (point)) + (if (not (he-string-member he-search-string he-tried-table)) + (push he-search-string he-tried-table)) + (setq he-expand-list + (and symbol (python-symbol-completions symbol))))) + (while (and he-expand-list + (he-string-member (car he-expand-list) he-tried-table)) + (pop he-expand-list)) + (if he-expand-list + (progn + (he-substitute-string (pop he-expand-list)) + t) + (if old (he-reset-string)) + nil))) + ;;;; Modes. (defvar outline-heading-end-regexp) (defvar eldoc-print-current-symbol-info-function) -(defvar python-mode-running) + ;;;###autoload (define-derived-mode python-mode fundamental-mode "Python" "Major mode for editing Python files. @@ -1576,11 +1710,10 @@ lines count as headers. )) (set (make-local-variable 'parse-sexp-lookup-properties) t) (set (make-local-variable 'comment-start) "# ") - ;; Fixme: define a comment-indent-function? + (set (make-local-variable 'comment-indent-function) #'python-comment-indent) (set (make-local-variable 'indent-line-function) #'python-indent-line) (set (make-local-variable 'paragraph-start) "\\s-*$") - (set (make-local-variable 'fill-paragraph-function) - 'python-fill-paragraph) + (set (make-local-variable 'fill-paragraph-function) 'python-fill-paragraph) (set (make-local-variable 'require-final-newline) t) (set (make-local-variable 'add-log-current-defun-function) #'python-current-defun) @@ -1598,6 +1731,9 @@ lines count as headers. #'python-eldoc-function) (add-hook 'eldoc-mode-hook '(lambda () (run-python 0 t)) nil t) ; need it running + (if (featurep 'hippie-exp) + (set (make-local-variable 'hippie-expand-try-functions-list) + (cons 'python-try-complete hippie-expand-try-functions-list))) (unless font-lock-mode (font-lock-mode 1)) (when python-guess-indent (python-guess-indent)) (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 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Michael Mauger <mmaug@yahoo.com> -;; Version: 2.0.0 +;; Version: 2.0.1 ;; Keywords: comm languages processes ;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode @@ -200,8 +200,11 @@ ;; Gregor Zych <zych@pool.informatik.rwth-aachen.de> ;; nino <nino@inform.dk> ;; Berend de Boer <berend@pobox.com> -;; Michael Mauger <mmaug@yahoo.com> ;; Adam Jenkins <adam@thejenkins.org> +;; Michael Mauger <mmaug@yahoo.com> -- improved product support +;; Drew Adams <drew.adams@oracle.com> -- Emacs 20 support +;; Harald Maier <maierh@myself.com> -- sql-send-string +;; Stefan Monnier <monnier@iro.umontreal.ca> -- font-lock corrections @@ -693,18 +696,6 @@ Starts `sql-interactive-mode' after doing some setup." ;;; Variables which do not need customization -(defvar sql-xemacs-p - (string-match "XEmacs\\|Lucid" emacs-version) - "Is this a non-GNU Emacs?") - -(defvar sql-emacs19-p - (string-match "GNU Emacs 19" emacs-version) - "Is this a GNU Emacs 19?") - -(defvar sql-emacs20-p - (string-match "20" emacs-version) - "Is this a GNU Emacs 20?") - (defvar sql-user-history nil "History of usernames used.") @@ -876,9 +867,7 @@ Based on `comint-mode-map'.") (modify-syntax-entry ?/ ". 14" table) (modify-syntax-entry ?* ". 23" table) ;; double-dash starts comment - (if sql-xemacs-p - (modify-syntax-entry ?- ". 56" table) - (modify-syntax-entry ?- ". 12b" table)) + (modify-syntax-entry ?- ". 12b" table) ;; newline and formfeed end coments (modify-syntax-entry ?\n "> b" table) (modify-syntax-entry ?\f "> b" table) @@ -905,25 +894,6 @@ The pattern matches the name in a CREATE, DROP or ALTER statement. The format of variable should be a valid `font-lock-keywords' entry.") -(defvar sql-builtin-face - (if sql-xemacs-p - ;; XEmacs doesn't have the builtin face - 'font-lock-preprocessor-face - ;; GNU Emacs 19 doesn't either - (if sql-emacs19-p - 'font-lock-keyword-face - ;; Emacs 2x - 'font-lock-builtin-face)) - "Builtin face for font-lock in SQL mode.") - -(defvar sql-doc-face - (if (or sql-xemacs-p - sql-emacs19-p - sql-emacs20-p) - 'font-lock-string-face - 'font-lock-doc-face) - "Documentation face for font-lock in SQL mode.") - (defmacro sql-keywords-re (&rest keywords) "Compile-time generation of regexp matching any one of KEYWORDS." `(eval-when-compile @@ -1020,7 +990,7 @@ statement. The format of variable should be a valid `((,ansi-non-reserved . font-lock-keyword-face) (,ansi-reserved . font-lock-keyword-face) - (,ansi-funcs . ,sql-builtin-face) + (,ansi-funcs . font-lock-builtin-face) (,ansi-types . font-lock-type-face))) "ANSI SQL keywords used by font-lock. @@ -1230,11 +1200,11 @@ add functions and PL/SQL keywords.") "\\b.*$" )))) - `((,sqlplus-commands . ,sql-doc-face) - (,oracle-functions . ,sql-builtin-face) + `((,sqlplus-commands . font-lock-doc-face) + (,oracle-functions . font-lock-builtin-face) (,oracle-keywords . font-lock-keyword-face) (,oracle-types . font-lock-type-face) - (,plsql-functions . ,sql-builtin-face) + (,plsql-functions . font-lock-builtin-face) (,plsql-keywords . font-lock-keyword-face) (,plsql-type . font-lock-type-face) (,plsql-warning . font-lock-warning-face))) @@ -1323,7 +1293,7 @@ to add functions and PL/SQL keywords.") "timestamp" "varchar" "varying" "void" "zone" ))) - `((,pg-funcs . ,sql-builtin-face) + `((,pg-funcs . font-lock-builtin-face) (,pg-reserved . font-lock-keyword-face) (,pg-types . font-lock-type-face))) @@ -1404,7 +1374,7 @@ you define your own sql-mode-postgres-font-lock-keywords.") `((,linter-keywords . font-lock-keyword-face) (,linter-reserved . font-lock-keyword-face) - (,linter-functions . ,sql-builtin-face) + (,linter-functions . font-lock-builtin-face) (,linter-types . font-lock-type-face))) "Linter SQL keywords used by font-lock. @@ -1507,9 +1477,9 @@ function `regexp-opt'.") ) t) "\\)\\)\\|go\\s-*\\|use\\s-+\\|setuser\\s-+\\|dbcc\\s-+\\).*$")))) - `((,ms-commands . ,sql-doc-face) + `((,ms-commands . font-lock-doc-face) (,ms-reserved . font-lock-keyword-face) - (,ms-functions . ,sql-builtin-face) + (,ms-functions . font-lock-builtin-face) (,ms-vars . font-lock-variable-name-face) (,ms-types . font-lock-type-face))) @@ -1626,7 +1596,7 @@ you define your own sql-mode-solid-font-lock-keywords.") "zerofill" ))) - `((,mysql-funcs . ,sql-builtin-face) + `((,mysql-funcs . font-lock-builtin-face) (,mysql-keywords . font-lock-keyword-face) (,mysql-types . font-lock-type-face))) @@ -1687,17 +1657,36 @@ the product-specific keywords and syntax-alists defined in ;; Get the product-specific keywords. (setq sql-mode-font-lock-keywords (append - (eval (sql-product-feature :font-lock)) + (unless (eq sql-product 'ansi) + (eval (sql-product-feature :font-lock))) + ;; Always highlight ANSI keywords (eval (sql-product-feature :font-lock 'ansi)) + ;; Fontify object names in CREATE, DROP and ALTER DDL + ;; statements (list sql-mode-font-lock-object-name))) - ;; Setup font-lock. (What is the minimum we should have to do - ;; here?) - (setq font-lock-set-defaults nil - font-lock-keywords sql-mode-font-lock-keywords - font-lock-defaults (list 'sql-mode-font-lock-keywords + ;; Setup font-lock. Force re-parsing of `font-lock-defaults'. + (set (make-local-variable 'font-lock-set-defaults) nil) + (setq font-lock-defaults (list 'sql-mode-font-lock-keywords keywords-only t syntax-alist)) + ;; Force font lock to reinitialize if it is already on + ;; Otherwise, we can wait until it can be started. + (when (and (fboundp 'font-lock-mode) + font-lock-mode) + (font-lock-mode-internal nil) + (font-lock-mode-internal t)) + + (add-hook 'font-lock-mode-hook + (lambda () + ;; Provide defaults for new font-lock faces. + (defvar font-lock-builtin-face + (if (boundp 'font-lock-preprocessor-face) + font-lock-preprocessor-face + font-lock-keyword-face)) + (defvar font-lock-doc-face font-lock-string-face)) + nil t) + ;; Setup imenu; it needs the same syntax-alist. (when imenu (setq imenu-syntax-alist syntax-alist)))) @@ -1744,11 +1733,6 @@ selected." ;; Setup font-lock (sql-product-font-lock nil t) - ;; Force fontification, if its enabled. - (if (and (boundp 'font-lock-mode) - font-lock-mode) - (font-lock-fontify-buffer)) - ;; Set the mode name to include the product. (setq mode-name (concat "SQL[" (prin1-to-string sql-product) "]")))) 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." #'ps-print-quote (list (concat "\n;;; ps-print version " ps-print-version "\n") + ";; internal vars" + (ps-comment-string "ps-print-emacs-type" ps-print-emacs-type) + (ps-comment-string "ps-windows-system " ps-windows-system) + (ps-comment-string "ps-lp-system " ps-lp-system) + nil '(25 . ps-print-color-p) '(25 . ps-lpr-command) '(25 . ps-lpr-switches) @@ -3657,14 +3662,28 @@ If `ps-prefix-quote' is nil, it's set to t after generating string." (if (> col len) (make-string (- col len) ?\ ) " ") - (cond ((null val) "nil") - ((eq val t) "t") - ((or (symbolp val) (listp val)) (format "'%S" val)) - (t (format "%S" val)))))) + (ps-value-string val)))) (t "") )) +(defun ps-value-string (val) + "Return a string representation of VAL. Used by `ps-print-quote'." + (cond ((null val) + "nil") + ((eq val t) + "t") + ((or (symbolp val) (listp val)) + (format "'%S" val)) + (t + (format "%S" val)))) + + +(defun ps-comment-string (str value) + "Return a comment string like \";; STR = VALUE\"." + (format ";; %s = %s" str (ps-value-string value))) + + (defun ps-value (alist-sym key) "Return value from association list ALIST-SYM which car is `eq' to KEY." (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." (if coding (setq coding (coding-system-base coding)) (setq coding 'raw-text)) - ;; Suppress producing escape sequences for compositions. - (remove-text-properties 0 (length str) '(composition nil) str) - (cond - ((eq type 'TEXT) - (if (not (multibyte-string-p str)) - ;; Don't have to encode unibyte string. - (setq type 'STRING) - ;; If STR contains only ASCII, Latin-1, and raw bytes, - ;; encode STR by iso-latin-1, and return it as type - ;; `STRING'. Otherwise, encode STR by CODING. In that - ;; case, the returing type depends on CODING. - (let ((charsets (find-charset-string str))) - (setq charsets - (delq 'ascii - (delq 'latin-iso8859-1 - (delq 'eight-bit-control - (delq 'eight-bit-graphic charsets))))) - (if charsets - (setq str (encode-coding-string str coding) - type (if (memq coding '(compound-text - compound-text-with-extensions)) - 'COMPOUND_TEXT - 'STRING)) - (setq type 'STRING - str (encode-coding-string str 'iso-latin-1)))))) - - ((eq type 'COMPOUND_TEXT) - (setq str (encode-coding-string str coding))) - - ((eq type 'STRING) - (if (memq coding '(compound-text - compound-text-with-extensions)) - (setq str (string-make-unibyte str)) - (setq str (encode-coding-string str coding)))) - - ((eq type 'UTF8_STRING) - (setq str (encode-coding-string str 'utf-8))) - - (t - (error "Unknow selection type: %S" type)) - )) + (let ((inhibit-read-only t)) + ;; Suppress producing escape sequences for compositions. + (remove-text-properties 0 (length str) '(composition nil) str) + (cond + ((eq type 'TEXT) + (if (not (multibyte-string-p str)) + ;; Don't have to encode unibyte string. + (setq type 'STRING) + ;; If STR contains only ASCII, Latin-1, and raw bytes, + ;; encode STR by iso-latin-1, and return it as type + ;; `STRING'. Otherwise, encode STR by CODING. In that + ;; case, the returing type depends on CODING. + (let ((charsets (find-charset-string str))) + (setq charsets + (delq 'ascii + (delq 'latin-iso8859-1 + (delq 'eight-bit-control + (delq 'eight-bit-graphic charsets))))) + (if charsets + (setq str (encode-coding-string str coding) + type (if (memq coding '(compound-text + compound-text-with-extensions)) + 'COMPOUND_TEXT + 'STRING)) + (setq type 'STRING + str (encode-coding-string str 'iso-latin-1)))))) + + ((eq type 'COMPOUND_TEXT) + (setq str (encode-coding-string str coding))) + + ((eq type 'STRING) + (if (memq coding '(compound-text + compound-text-with-extensions)) + (setq str (string-make-unibyte str)) + (setq str (encode-coding-string str coding)))) + + ((eq type 'UTF8_STRING) + (setq str (encode-coding-string str 'utf-8))) + + (t + (error "Unknow selection type: %S" type)) + ))) (setq next-selection-coding-system nil) (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." (ses-aset-with-undo (symbol-value def) elem value) (ses-set-with-undo def value)) (let ((inhibit-read-only t) - (fmt (plist-get '(ses--column-widths "(ses-column-widths %S)" + (fmt (plist-get '(ses--col-widths "(ses-column-widths %S)" ses--col-printers "(ses-column-printers %S)" ses--default-printer "(ses-default-printer %S)" 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. If arg is negative, kill backward. Also kill the preceding newline. \(This is meant to make C-x z work well with negative arguments.\) If arg is zero, kill current line but exclude the trailing newline." - (interactive "P") - (setq arg (prefix-numeric-value arg)) + (interactive "p") (if (and (> arg 0) (eobp) (save-excursion (forward-visible-line 0) (eobp))) (signal 'end-of-buffer nil)) (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. But documentation strings are usually not useful in nameless functions. INTERACTIVE should be a call to the function `interactive', which see. It may also be omitted. -BODY should be a list of Lisp expressions." +BODY should be a list of Lisp expressions. + +\(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)" ;; Note that this definition should not use backquotes; subr.el should not ;; depend on backquote.el. (list 'function (cons 'lambda cdr))) @@ -161,7 +163,7 @@ the return value (nil if RESULT is omitted). (defmacro declare (&rest specs) "Do not evaluate any arguments and return nil. Treated as a declaration when used at the right place in a -`defmacro' form. \(See Info anchor `(elisp)Definition of declare'." +`defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)" nil) (defsubst caar (x) @@ -180,34 +182,34 @@ Treated as a declaration when used at the right place in a "Return the cdr of the cdr of X." (cdr (cdr x))) -(defun last (x &optional n) - "Return the last link of the list X. Its car is the last element. -If X is nil, return nil. -If N is non-nil, return the Nth-to-last link of X. -If N is bigger than the length of X, return X." +(defun last (list &optional n) + "Return the last link of LIST. Its car is the last element. +If LIST is nil, return nil. +If N is non-nil, return the Nth-to-last link of LIST. +If N is bigger than the length of LIST, return LIST." (if n - (let ((m 0) (p x)) + (let ((m 0) (p list)) (while (consp p) (setq m (1+ m) p (cdr p))) (if (<= n 0) p - (if (< n m) (nthcdr (- m n) x) x))) - (while (consp (cdr x)) - (setq x (cdr x))) - x)) + (if (< n m) (nthcdr (- m n) list) list))) + (while (consp (cdr list)) + (setq list (cdr list))) + list)) -(defun butlast (x &optional n) +(defun butlast (list &optional n) "Returns a copy of LIST with the last N elements removed." - (if (and n (<= n 0)) x - (nbutlast (copy-sequence x) n))) + (if (and n (<= n 0)) list + (nbutlast (copy-sequence list) n))) -(defun nbutlast (x &optional n) +(defun nbutlast (list &optional n) "Modifies LIST to remove the last N elements." - (let ((m (length x))) + (let ((m (length list))) (or n (setq n 1)) (and (< n m) (progn - (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) - x)))) + (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) + list)))) (defun delete-dups (list) "Destructively remove `equal' duplicates from LIST. @@ -1114,6 +1116,7 @@ FILE should be the name of a library, with no directory name." "Open a TCP connection for a service to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. + Args are NAME BUFFER HOST SERVICE. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer (or buffer-name) to associate with the process. @@ -1178,12 +1181,13 @@ does not use these function." ;; compatibility +(make-obsolete 'process-kill-without-query + "use `process-query-on-exit-flag'\nor `set-process-query-on-exit-flag'." + "21.5") (defun process-kill-without-query (process &optional flag) "Say no query needed if PROCESS is running when Emacs is exited. Optional second argument if non-nil says to require a query. -Value is t if a query was formerly required. -New code should not use this function; use `process-query-on-exit-flag' -or `set-process-query-on-exit-flag' instead." +Value is t if a query was formerly required." (let ((old (process-query-on-exit-flag process))) (set-process-query-on-exit-flag process nil) old)) @@ -1693,26 +1697,27 @@ If UNDO is present and non-nil, it is a function that will be called (if (nth 4 handler) ;; COMMAND (setq this-command (nth 4 handler))))) -(defun insert-buffer-substring-no-properties (buf &optional start end) - "Insert before point a substring of buffer BUFFER, without text properties. +(defun insert-buffer-substring-no-properties (buffer &optional start end) + "Insert before point a substring of BUFFER, without text properties. BUFFER may be a buffer or a buffer name. Arguments START and END are character numbers specifying the substring. They default to the beginning and the end of BUFFER." (let ((opoint (point))) - (insert-buffer-substring buf start end) + (insert-buffer-substring buffer start end) (let ((inhibit-read-only t)) (set-text-properties opoint (point) nil)))) -(defun insert-buffer-substring-as-yank (buf &optional start end) - "Insert before point a part of buffer BUFFER, stripping some text properties. -BUFFER may be a buffer or a buffer name. Arguments START and END are -character numbers specifying the substring. They default to the -beginning and the end of BUFFER. Strip text properties from the -inserted text according to `yank-excluded-properties'." +(defun insert-buffer-substring-as-yank (buffer &optional start end) + "Insert before point a part of BUFFER, stripping some text properties. +BUFFER may be a buffer or a buffer name. +Arguments START and END are character numbers specifying the substring. +They default to the beginning and the end of BUFFER. +Strip text properties from the inserted text according to +`yank-excluded-properties'." ;; Since the buffer text should not normally have yank-handler properties, ;; there is no need to handle them here. (let ((opoint (point))) - (insert-buffer-substring buf start end) + (insert-buffer-substring buffer start end) (remove-yank-excluded-properties opoint (point)))) @@ -2073,7 +2078,7 @@ which separates, but is not part of, the substrings. If nil it defaults to `split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and OMIT-NULLS is forced to t. -If OMIT-NULLs is t, zero-length substrings are omitted from the list \(so +If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so that for the default value of SEPARATORS leading and trailing whitespace are effectively trimmed). If nil, all zero-length substrings are retained, which 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 @@ (require 'faces) (require 'select) (require 'menu-bar) +(require 'x-dnd) ;; Conditional on new-fontset so bootstrapping works on non-GUI compiles (if (fboundp 'new-fontset) (require 'fontset)) @@ -105,7 +106,10 @@ Switch to a buffer editing the last file dropped." (y (cdr coords))) (if (and (> x 0) (> y 0)) (set-frame-selected-window nil window)) - (mapcar 'find-file (car (cdr (cdr event))))) + (mapcar (lambda (file-name) + (x-dnd-handle-one-url window 'private + (concat "file:" file-name))) + (car (cdr (cdr event))))) (raise-frame))) (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.") (defun x-clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive) - (let ((clipboard-text (x-get-selection 'CLIPBOARD)) + (let ((clipboard-text + (condition-case nil + (x-get-selection 'CLIPBOARD) + (error nil))) (x-select-enable-clipboard t)) (if (and clipboard-text (> (length clipboard-text) 0)) (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 @@ ;;; bibtex.el --- BibTeX mode for GNU Emacs -;; Copyright (C) 1992,94,95,96,97,98,1999,2003 Free Software Foundation, Inc. +;; Copyright (C) 1992,94,95,96,97,98,1999,2003,2004 +;; Free Software Foundation, Inc. ;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de> ;; Bengt Martensson <bengt@mathematik.uni-Bremen.de> @@ -811,6 +812,7 @@ If non-nil, the column for the equal sign is the value of (define-key km "\C-c\M-y" 'bibtex-yank-pop) (define-key km "\C-c\C-d" 'bibtex-empty-field) (define-key km "\C-c\C-f" 'bibtex-make-field) + (define-key km "\C-c\C-u" 'bibtex-entry-update) (define-key km "\C-c$" 'bibtex-ispell-abstract) (define-key km "\M-\C-a" 'bibtex-beginning-of-entry) (define-key km "\M-\C-e" 'bibtex-end-of-entry) @@ -1122,44 +1124,6 @@ function `bibtex-parse-field-name'.") '(bibtex-mode "@\\S(*\\s(" "\\s)" nil bibtex-hs-forward-sexp nil)) -(defconst bibtex-braced-string-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?\{ "(}" st) - (modify-syntax-entry ?\} "){" st) - (modify-syntax-entry ?\[ "." st) - (modify-syntax-entry ?\] "." st) - (modify-syntax-entry ?\( "." st) - (modify-syntax-entry ?\) "." st) - (modify-syntax-entry ?\\ "." st) - (modify-syntax-entry ?\" "." st) - st) - "Syntax-table to parse matched braces.") - -(defconst bibtex-quoted-string-syntax-table - (let ((st (make-syntax-table))) - (modify-syntax-entry ?\\ "\\" st) - (modify-syntax-entry ?\" "\"" st) - st) - "Syntax-table to parse matched quotes.") - -(defun bibtex-parse-field-string () - "Parse a field string enclosed by braces or quotes. -If a syntactically correct string is found, a pair containing the start and -end position of the field string is returned, nil otherwise." - (let ((end-point - (or (and (eq (following-char) ?\") - (save-excursion - (with-syntax-table bibtex-quoted-string-syntax-table - (forward-sexp 1)) - (point))) - (and (eq (following-char) ?\{) - (save-excursion - (with-syntax-table bibtex-braced-string-syntax-table - (forward-sexp 1)) - (point)))))) - (if end-point - (cons (point) end-point)))) - (defun bibtex-parse-association (parse-lhs parse-rhs) "Parse a string of the format <left-hand-side = right-hand-side>. The functions PARSE-LHS and PARSE-RHS are used to parse the corresponding @@ -1199,6 +1163,44 @@ BibTeX field as necessary." ;; Now try again. (bibtex-parse-field-name)))) +(defconst bibtex-braced-string-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?\{ "(}" st) + (modify-syntax-entry ?\} "){" st) + (modify-syntax-entry ?\[ "." st) + (modify-syntax-entry ?\] "." st) + (modify-syntax-entry ?\( "." st) + (modify-syntax-entry ?\) "." st) + (modify-syntax-entry ?\\ "." st) + (modify-syntax-entry ?\" "." st) + st) + "Syntax-table to parse matched braces.") + +(defconst bibtex-quoted-string-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?\\ "\\" st) + (modify-syntax-entry ?\" "\"" st) + st) + "Syntax-table to parse matched quotes.") + +(defun bibtex-parse-field-string () + "Parse a field string enclosed by braces or quotes. +If a syntactically correct string is found, a pair containing the start and +end position of the field string is returned, nil otherwise." + (let ((end-point + (or (and (eq (following-char) ?\") + (save-excursion + (with-syntax-table bibtex-quoted-string-syntax-table + (forward-sexp 1)) + (point))) + (and (eq (following-char) ?\{) + (save-excursion + (with-syntax-table bibtex-braced-string-syntax-table + (forward-sexp 1)) + (point)))))) + (if end-point + (cons (point) end-point)))) + (defun bibtex-parse-field-text () "Parse the text part of a BibTeX field. The text part is either a string, or an empty string, or a constant followed @@ -1410,7 +1412,7 @@ delimiters if present." (let ((content (buffer-substring-no-properties (nth 0 (cdr bounds)) (nth 1 (cdr bounds))))) (if (and remove-delim - (string-match "\\`{\\(.*\\)}\\'" content)) + (string-match "\\`[{\"]\\(.*\\)[}\"]\\'" content)) (substring content (match-beginning 1) (match-end 1)) content))) @@ -1455,16 +1457,6 @@ The value is actually the tail of LIST whose car matches STRING." (setq list (cdr list))) list)) -(defun bibtex-assoc-of-regexp (string alist) - "Return non-nil if STRING is exactly matched by the car of an -element of ALIST (case ignored). The value is actually the element -of LIST whose car matches STRING." - (let ((case-fold-search t)) - (while (and alist - (not (string-match (concat "\\`\\(?:" (caar alist) "\\)\\'") string))) - (setq alist (cdr alist))) - (car alist))) - (defun bibtex-skip-to-valid-entry (&optional backward) "Unless at beginning of a valid BibTeX entry, move point to beginning of the next valid one. With optional argument BACKWARD non-nil, move backward to @@ -1519,8 +1511,8 @@ FUN will not be called for @String entries." If FLAG is a string, the message is initialized (in this case a value for INTERVAL may be given as well (if not this is set to 5)). If FLAG is done, the message is deinitialized. -If FLAG is absent, a message is echoed if point was incremented -at least INTERVAL percent since last message was echoed." +If FLAG is nil, a message is echoed if point was incremented at least +`bibtex-progress-interval' percent since last message was echoed." (cond ((stringp flag) (setq bibtex-progress-lastmes flag) (setq bibtex-progress-interval (or interval 5) @@ -1685,11 +1677,11 @@ are defined, but only for the head part of the entry "Try to avoid point being at end of a BibTeX field." (end-of-line) (skip-chars-backward " \t") - (cond ((= (preceding-char) ?,) - (forward-char -2))) - (cond ((or (= (preceding-char) ?}) - (= (preceding-char) ?\")) - (forward-char -1)))) + (if (= (preceding-char) ?,) + (forward-char -2)) + (if (or (= (preceding-char) ?}) + (= (preceding-char) ?\")) + (forward-char -1))) (defun bibtex-enclosing-field (&optional noerr) "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)." (error "Unknown tag field: %s. Please submit a bug report" bibtex-last-kill-command)))))) +(defun bibtex-assoc-regexp (regexp alist) + "Return non-nil if REGEXP matches the car of an element of ALIST. +The value is actually the element of ALIST matched by REGEXP. +Case is ignored if `case-fold-search' is non-nil in the current buffer." + (while (and alist + (not (string-match regexp (caar alist)))) + (setq alist (cdr alist))) + (car alist)) + (defun bibtex-format-entry () "Helper function for `bibtex-clean-entry'. Formats current entry according to variable `bibtex-entry-format'." @@ -1763,7 +1764,7 @@ Formats current entry according to variable `bibtex-entry-format'." unify-case inherit-booktitle) bibtex-entry-format)) crossref-key bounds alternatives-there non-empty-alternative - entry-list req creq field-done field-list) + entry-list req-field-list field-done field-list) ;; identify entry type (goto-char (point-min)) @@ -1772,9 +1773,7 @@ Formats current entry according to variable `bibtex-entry-format'." (end-type (match-end 0))) (setq entry-list (assoc-ignore-case (buffer-substring-no-properties beg-type end-type) - bibtex-entry-field-alist) - req (nth 0 (nth 1 entry-list)) ; required part - creq (nth 0 (nth 2 entry-list))) ; crossref part + bibtex-entry-field-alist)) ;; unify case of entry name (when (memq 'unify-case format) @@ -1791,20 +1790,32 @@ Formats current entry according to variable `bibtex-entry-format'." ;; determine if entry has crossref field and if at least ;; one alternative is non-empty (goto-char (point-min)) - (while (setq bounds (bibtex-search-forward-field - bibtex-field-name)) - (goto-char (bibtex-start-of-name-in-field bounds)) - (cond ((looking-at "ALT") - (setq alternatives-there t) - (goto-char (bibtex-start-of-text-in-field bounds)) - (if (not (looking-at bibtex-empty-field-re)) - (setq non-empty-alternative t))) - ((and (looking-at "\\(OPT\\)?crossref\\>") - (progn (goto-char (bibtex-start-of-text-in-field bounds)) - (not (looking-at bibtex-empty-field-re)))) - (setq crossref-key - (bibtex-text-in-field-bounds bounds t)))) - (goto-char (bibtex-end-of-field bounds))) + (let* ((fields-alist (bibtex-parse-entry)) + (case-fold-search t) + (field (bibtex-assoc-regexp "\\(OPT\\)?crossref\\>" + fields-alist))) + (setq crossref-key (and field + (not (string-match bibtex-empty-field-re + (cdr field))) + (cdr field)) + req-field-list (if crossref-key + (nth 0 (nth 2 entry-list)) ; crossref part + (nth 0 (nth 1 entry-list)))) ; required part + + (dolist (rfield req-field-list) + (when (nth 3 rfield) ; we should have an alternative + (setq alternatives-there t + field (bibtex-assoc-regexp + (concat "\\(ALT\\)?" (car rfield) "\\>") + fields-alist)) + (if (and field + (not (string-match bibtex-empty-field-re + (cdr field)))) + (cond ((not non-empty-alternative) + (setq non-empty-alternative t)) + ((memq 'required-fields format) + (error "More than one non-empty alternative."))))))) + (if (and alternatives-there (not non-empty-alternative) (memq 'required-fields format)) @@ -1832,18 +1843,23 @@ Formats current entry according to variable `bibtex-entry-format'." ;; quite some redundancy compared with what we need to do ;; anyway. So for speed-up we avoid using them. - (when (and opt-alt - (memq 'opts-or-alts format)) - (if empty-field - ;; Either it is an empty ALT field. Then we have checked - ;; already that we have one non-empty alternative. - ;; Or it is an empty OPT field that we do not miss anyway. - ;; So we can safely delete this field. - (progn (delete-region beg-field end-field) - (setq deleted t)) - ;; otherwise: not empty, delete "OPT" or "ALT" - (goto-char beg-name) - (delete-char 3))) + (if (memq 'opts-or-alts format) + (cond ((and empty-field + (or opt-alt + (let ((field (assoc-ignore-case + field-name req-field-list))) + (or (not field) ; OPT field + (nth 3 field))))) ; ALT field + ;; Either it is an empty ALT field. Then we have checked + ;; already that we have one non-empty alternative. Or it + ;; is an empty OPT field that we do not miss anyway. + ;; So we can safely delete this field. + (delete-region beg-field end-field) + (setq deleted t)) + ;; otherwise: not empty, delete "OPT" or "ALT" + (opt-alt + (goto-char beg-name) + (delete-char 3)))) (unless deleted (push field-name field-list) @@ -1902,8 +1918,7 @@ Formats current entry according to variable `bibtex-entry-format'." ;; if empty field, complain (if (and empty-field (memq 'required-fields format) - (assoc-ignore-case field-name - (if crossref-key creq req))) + (assoc-ignore-case field-name req-field-list)) (error "Mandatory field `%s' is empty" field-name)) ;; unify case of field name @@ -1925,8 +1940,8 @@ Formats current entry according to variable `bibtex-entry-format'." ;; check whether all required fields are present (if (memq 'required-fields format) - (let (altlist (found 0)) - (dolist (fname (if crossref-key creq req)) + (let ((found 0) altlist) + (dolist (fname req-field-list) (if (nth 3 fname) (push (car fname) altlist)) (unless (or (member (car fname) field-list) @@ -1940,7 +1955,7 @@ Formats current entry according to variable `bibtex-entry-format'." (error "Alternative mandatory field `%s' is missing" altlist)) ((> found 1) - (error "Alternative fields `%s' is defined %s times" + (error "Alternative fields `%s' are defined %s times" altlist found)))))) ;; update point @@ -2051,8 +2066,8 @@ and return results as a list." (setq titlestring (substring titlestring 0 (match-beginning 0)))))) ;; gather words from titlestring into a list. Ignore ;; specific words and use only a specific amount of words. - (let (case-fold-search titlewords titlewords-extra titleword end-match - (counter 0)) + (let ((counter 0) + case-fold-search titlewords titlewords-extra titleword end-match) (while (and (or (not (numberp bibtex-autokey-titlewords)) (< counter (+ bibtex-autokey-titlewords bibtex-autokey-titlewords-stretch))) @@ -2079,10 +2094,14 @@ and return results as a list." "Do some abbreviations on TITLEWORD. The rules are defined in `bibtex-autokey-titleword-abbrevs' and `bibtex-autokey-titleword-length'." - (let ((abbrev (bibtex-assoc-of-regexp - titleword bibtex-autokey-titleword-abbrevs))) - (if abbrev - (cdr abbrev) + (let ((case-folde-search t) + (alist bibtex-autokey-titleword-abbrevs)) + (while (and alist + (not (string-match (concat "\\`\\(?:" (caar alist) "\\)\\'") + titleword))) + (setq alist (cdr alist))) + (if alist + (cdar alist) (bibtex-autokey-abbrev titleword bibtex-autokey-titleword-length)))) @@ -2384,6 +2403,7 @@ of a word, all strings are listed. Return completion." (display-completion-list (all-completions part-of-word completions))) (message "Making completion list...done") + ;; return value is handled by choose-completion-string-functions nil)))) (defun bibtex-complete-string-cleanup (str) @@ -2629,6 +2649,34 @@ non-nil. (easy-menu-add bibtex-entry-menu) (run-hooks 'bibtex-mode-hook)) +(defun bibtex-field-list (entry-type) + "Return list of allowed fields for entry ENTRY-TYPE. +More specifically, the return value is a cons pair (REQUIRED . OPTIONAL), +where REQUIRED and OPTIONAL are lists of the required and optional field +names for ENTRY-TYPE according to `bibtex-entry-field-alist'." + (let ((e (assoc-ignore-case entry-type bibtex-entry-field-alist)) + required optional) + (unless e + (error "Bibtex entry type %s not defined" entry-type)) + (if (and (member-ignore-case entry-type bibtex-include-OPTcrossref) + (nth 2 e)) + (setq required (nth 0 (nth 2 e)) + optional (nth 1 (nth 2 e))) + (setq required (nth 0 (nth 1 e)) + optional (nth 1 (nth 1 e)))) + (if bibtex-include-OPTkey + (push (list "key" + "Used for reference key creation if author and editor fields are missing" + (if (or (stringp bibtex-include-OPTkey) + (fboundp bibtex-include-OPTkey)) + bibtex-include-OPTkey)) + optional)) + (if (member-ignore-case entry-type bibtex-include-OPTcrossref) + (push '("crossref" "Reference key of the cross-referenced entry") + optional)) + (setq optional (append optional bibtex-user-optional-fields)) + (cons required optional))) + (defun bibtex-entry (entry-type) "Insert a new BibTeX entry. After 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'." bibtex-entry-field-alist nil t nil 'bibtex-entry-type-history))) (list e-t))) - (let* (required optional - (key (if bibtex-maintain-sorted-entries - (bibtex-read-key (format "%s key: " entry-type)))) - (e (assoc-ignore-case entry-type bibtex-entry-field-alist)) - (r-n-o (elt e 1)) - (c-ref (elt e 2))) - (if (not e) - (error "Bibtex entry type %s not defined" entry-type)) - (if (and (member entry-type bibtex-include-OPTcrossref) - c-ref) - (setq required (elt c-ref 0) - optional (elt c-ref 1)) - (setq required (elt r-n-o 0) - optional (elt r-n-o 1))) + (let ((key (if bibtex-maintain-sorted-entries + (bibtex-read-key (format "%s key: " entry-type)))) + (field-list (bibtex-field-list entry-type))) (unless (bibtex-prepare-new-entry (list key nil entry-type)) (error "Entry with key `%s' already exists" key)) (indent-to-column bibtex-entry-offset) (insert "@" entry-type (bibtex-entry-left-delimiter)) - (if key - (insert key)) + (if key (insert key)) (save-excursion - (mapcar 'bibtex-make-field required) - (if (member entry-type bibtex-include-OPTcrossref) - (bibtex-make-optional-field '("crossref"))) - (if bibtex-include-OPTkey - (if (or (stringp bibtex-include-OPTkey) - (fboundp bibtex-include-OPTkey)) - (bibtex-make-optional-field - (list "key" nil bibtex-include-OPTkey)) - (bibtex-make-optional-field '("key")))) - (mapcar 'bibtex-make-optional-field optional) - (mapcar 'bibtex-make-optional-field bibtex-user-optional-fields) + (mapcar 'bibtex-make-field (car field-list)) + (mapcar 'bibtex-make-optional-field (cdr field-list)) (if bibtex-comma-after-last-field (insert ",")) (insert "\n") @@ -2680,10 +2707,31 @@ After insertion it calls the functions in `bibtex-add-entry-hook'." (bibtex-autofill-entry)) (run-hooks 'bibtex-add-entry-hook))) +(defun bibtex-entry-update () + "Update an existing BibTeX entry. +In the BibTeX entry at point, make new fields for those items that may occur +according to `bibtex-entry-field-alist', but are not yet present." + (interactive) + (save-excursion + (bibtex-beginning-of-entry) + ;; For inserting new fields, we use the fact that + ;; bibtex-parse-entry moves point to the end of the last field. + (let* ((fields-alist (bibtex-parse-entry)) + (field-list (bibtex-field-list + (substring (cdr (assoc "=type=" fields-alist)) + 1)))) ; don't want @ + (dolist (field (car field-list)) + (unless (assoc-ignore-case (car field) fields-alist) + (bibtex-make-field field))) + (dolist (field (cdr field-list)) + (unless (assoc-ignore-case (car field) fields-alist) + (bibtex-make-optional-field field)))))) + (defun bibtex-parse-entry () "Parse entry at point, return an alist. The alist elements have the form (FIELD . TEXT), where FIELD can also be -the special strings \"=type=\" and \"=key=\"." +the special strings \"=type=\" and \"=key=\". +Move point to the end of the last field." (let (alist bounds) (when (looking-at bibtex-entry-head) (push (cons "=type=" (match-string bibtex-type-in-head)) alist) @@ -2774,28 +2822,14 @@ the special strings \"=type=\" and \"=key=\"." (looking-at "OPT\\|ALT")) (match-end 0) mb) (bibtex-end-of-name-in-field bounds))) - (entry-type (progn (re-search-backward - bibtex-entry-maybe-empty-head nil t) - (bibtex-type-in-head))) - (entry-list (assoc-ignore-case entry-type - bibtex-entry-field-alist)) - (c-r-list (elt entry-list 2)) - (req-opt-list (if (and (member entry-type - bibtex-include-OPTcrossref) - c-r-list) - c-r-list - (elt entry-list 1))) - (list-of-entries (append (elt req-opt-list 0) - (elt req-opt-list 1) - bibtex-user-optional-fields - (if (member entry-type - bibtex-include-OPTcrossref) - '(("crossref" "Reference key of the cross-referenced entry"))) - (if bibtex-include-OPTkey - '(("key" "Used for reference key creation if author and editor fields are missing"))))) - (comment (assoc-ignore-case field-name list-of-entries))) + (field-list (bibtex-field-list (progn (re-search-backward + bibtex-entry-maybe-empty-head nil t) + (bibtex-type-in-head)))) + (comment (assoc-ignore-case field-name + (append (car field-list) + (cdr field-list))))) (if comment - (message (elt comment 1)) + (message (nth 1 comment)) (message "No comment available"))))) (defun bibtex-make-field (field &optional called-by-yank) @@ -2804,24 +2838,13 @@ FIELD is either a string or a list of the form \(FIELD-NAME COMMENT-STRING INIT ALTERNATIVE-FLAG) as in `bibtex-entry-field-alist'." (interactive - (list (let* ((entry-type - (save-excursion - (bibtex-enclosing-entry-maybe-empty-head) - (bibtex-type-in-head))) - ;; "preliminary" completion list - (fl (nth 1 (assoc-ignore-case - entry-type bibtex-entry-field-alist))) - ;; "full" completion list - (field-list (append (nth 0 fl) - (nth 1 fl) - bibtex-user-optional-fields - (if (member entry-type - bibtex-include-OPTcrossref) - '(("crossref"))) - (if bibtex-include-OPTkey - '(("key"))))) - (completion-ignore-case t)) - (completing-read "BibTeX field name: " field-list + (list (let ((completion-ignore-case t) + (field-list (bibtex-field-list + (save-excursion + (bibtex-enclosing-entry-maybe-empty-head) + (bibtex-type-in-head))))) + (completing-read "BibTeX field name: " + (append (car field-list) (cdr field-list)) nil nil nil bibtex-field-history)))) (unless (consp field) (setq field (list field))) @@ -2848,8 +2871,9 @@ FIELD is either a string or a list of the form ((fboundp init) (insert (funcall init))))) (if (not called-by-yank) (insert (bibtex-field-right-delimiter))) - (if (interactive-p) - (forward-char -1))) + (when (interactive-p) + (forward-char -1) + (bibtex-print-help-message))) (defun bibtex-beginning-of-entry () "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." "\\(OPT\\)?crossref" t))) (list key (if bounds (bibtex-text-in-field-bounds bounds t)) - entry-name)))) - (list key nil entry-name))))) + entry-name))) + (list key nil entry-name)))))) (defun bibtex-lessp (index1 index2) "Predicate for sorting BibTeX entries with indices INDEX1 and INDEX2. Each index is a list (KEY CROSSREF-KEY ENTRY-NAME). -The predicate depends on the variable `bibtex-maintain-sorted-entries'." +The predicate depends on the variable `bibtex-maintain-sorted-entries'. +If its value is nil use plain sorting." (cond ((not index1) (not index2)) ; indices can be nil ((not index2) nil) ((equal bibtex-maintain-sorted-entries 'crossref) @@ -3017,12 +3042,10 @@ The predicate depends on the variable `bibtex-maintain-sorted-entries'." (defun bibtex-sort-buffer () "Sort BibTeX buffer alphabetically by key. The predicate for sorting is defined via `bibtex-maintain-sorted-entries'. -Text outside of BibTeX entries is not affected. If -`bibtex-sort-ignore-string-entries' is non-nil, @String entries will be -ignored." +If its value is nil use plain sorting. Text outside of BibTeX entries is not +affected. If `bibtex-sort-ignore-string-entries' is non-nil, @String entries +will be ignored." (interactive) - (unless bibtex-maintain-sorted-entries - (error "You must choose a sorting scheme")) (save-restriction (narrow-to-region (bibtex-beginning-of-first-entry) (save-excursion (goto-char (point-max)) @@ -3523,27 +3546,30 @@ At end of the cleaning process, the functions in (match-end bibtex-key-in-head))) (insert key)) ;; sorting - (let* ((start (bibtex-beginning-of-entry)) - (end (progn (bibtex-end-of-entry) - (if (re-search-forward - bibtex-entry-maybe-empty-head nil 'move) - (goto-char (match-beginning 0))) - (point))) - (entry (buffer-substring start end)) - (index (progn (goto-char start) - (bibtex-entry-index)))) - (delete-region start end) - (unless (prog1 (or called-by-reformat - (if (and bibtex-maintain-sorted-entries - (not (and bibtex-sort-ignore-string-entries - (equal entry-type "string")))) - (bibtex-prepare-new-entry index) - (not (bibtex-find-entry (car index))))) - (insert entry) - (forward-char -1) - (bibtex-beginning-of-entry) ; moves backward - (re-search-forward bibtex-entry-head)) - (error "New inserted entry yields duplicate key"))) + (unless called-by-reformat + (let* ((start (bibtex-beginning-of-entry)) + (end (progn (bibtex-end-of-entry) + (if (re-search-forward + bibtex-entry-maybe-empty-head nil 'move) + (goto-char (match-beginning 0))) + (point))) + (entry (buffer-substring start end)) + (index (progn (goto-char start) + (bibtex-entry-index))) + no-error) + (if (and bibtex-maintain-sorted-entries + (not (and bibtex-sort-ignore-string-entries + (equal entry-type "string")))) + (progn + (delete-region start end) + (setq no-error (bibtex-prepare-new-entry index)) + (insert entry) + (forward-char -1) + (bibtex-beginning-of-entry) ; moves backward + (re-search-forward bibtex-entry-head)) + (setq no-error (bibtex-find-entry (car index)))) + (unless no-error + (error "New inserted entry yields duplicate key")))) ;; final clean up (unless called-by-reformat (save-excursion @@ -3621,91 +3647,89 @@ If `bibtex-align-at-equal-sign' is non-nil, align equal signs, too." (indent-to-column bibtex-entry-offset) (goto-char pnt))) -(defun bibtex-reformat (&optional additional-options called-by-convert-alien) +(defun bibtex-realign () + "Realign BibTeX entries such that they are separated by one blank line." + (goto-char (point-min)) + (let ((case-fold-search t)) + (when (looking-at bibtex-valid-entry-whitespace-re) + (replace-match "\\1")) + (while (re-search-forward bibtex-valid-entry-whitespace-re nil t) + (replace-match "\n\n\\1")))) + +(defun bibtex-reformat (&optional read-options) "Reformat all BibTeX entries in buffer or region. With prefix argument, read options for reformatting from minibuffer. With \\[universal-argument] \\[universal-argument] prefix argument, reuse previous answers (if any) again. -If mark is active it reformats entries in region, if not in whole buffer." +If mark is active reformat entries in region, if not in whole buffer." (interactive "*P") (let* ((pnt (point)) (use-previous-options - (and (equal (prefix-numeric-value additional-options) 16) + (and (equal (prefix-numeric-value read-options) 16) (or bibtex-reformat-previous-options bibtex-reformat-previous-reference-keys))) (bibtex-entry-format - (if additional-options + (if read-options (if use-previous-options bibtex-reformat-previous-options (setq bibtex-reformat-previous-options - (delq nil (list - (if (or called-by-convert-alien - (y-or-n-p "Realign entries (recommended)? ")) - 'realign) - (if (y-or-n-p "Remove empty optional and alternative fields? ") - 'opts-or-alts) - (if (y-or-n-p "Remove delimiters around pure numerical fields? ") - 'numerical-fields) - (if (y-or-n-p (concat (if bibtex-comma-after-last-field "Insert" "Remove") - " comma at end of entry? ")) - 'last-comma) - (if (y-or-n-p "Replace double page dashes by single ones? ") - 'page-dashes) - (if (y-or-n-p "Force delimiters? ") - 'delimiters) - (if (y-or-n-p "Unify case of entry types and field names? ") - 'unify-case))))) + (mapcar (lambda (option) + (if (y-or-n-p (car option)) (cdr option))) + `(("Realign entries (recommended)? " . 'realign) + ("Remove empty optional and alternative fields? " . 'opts-or-alts) + ("Remove delimiters around pure numerical fields? " . 'numerical-fields) + (,(concat (if bibtex-comma-after-last-field "Insert" "Remove") + " comma at end of entry? ") . 'last-comma) + ("Replace double page dashes by single ones? " . 'page-dashes) + ("Force delimiters? " . 'delimiters) + ("Unify case of entry types and field names? " . 'unify-case))))) '(realign))) - (reformat-reference-keys (if additional-options - (if use-previous-options - bibtex-reformat-previous-reference-keys - (setq bibtex-reformat-previous-reference-keys - (y-or-n-p "Generate new reference keys automatically? "))))) - bibtex-autokey-edit-before-use - (bibtex-sort-ignore-string-entries t) + (reformat-reference-keys + (if read-options + (if use-previous-options + bibtex-reformat-previous-reference-keys + (setq bibtex-reformat-previous-reference-keys + (y-or-n-p "Generate new reference keys automatically? "))))) (start-point (if (bibtex-mark-active) (region-beginning) - (bibtex-beginning-of-first-entry) - (bibtex-skip-to-valid-entry) - (point))) + (point-min))) (end-point (if (bibtex-mark-active) (region-end) - (point-max)))) + (point-max))) + (bibtex-sort-ignore-string-entries t) + bibtex-autokey-edit-before-use) + (save-restriction (narrow-to-region start-point end-point) - (when (memq 'realign bibtex-entry-format) - (goto-char (point-min)) - (while (re-search-forward bibtex-valid-entry-whitespace-re nil t) - (replace-match "\n\\1"))) + (if (memq 'realign bibtex-entry-format) + (bibtex-realign)) (goto-char start-point) (bibtex-progress-message "Formatting" 1) (bibtex-map-entries (lambda (key beg end) (bibtex-progress-message) - (bibtex-clean-entry reformat-reference-keys t) - (when (memq 'realign bibtex-entry-format) - (goto-char end) - (bibtex-delete-whitespace) - (open-line 2)))) + (bibtex-clean-entry reformat-reference-keys t))) + (when (memq 'realign bibtex-entry-format) + (bibtex-delete-whitespace) + (open-line (if (eobp) 1 2))) (bibtex-progress-message 'done)) (when (and reformat-reference-keys - bibtex-maintain-sorted-entries - (not called-by-convert-alien)) + bibtex-maintain-sorted-entries) + (bibtex-progress-message "Sorting" 1) (bibtex-sort-buffer) - (kill-local-variable 'bibtex-reference-keys)) + (kill-local-variable 'bibtex-reference-keys) + (bibtex-progress-message 'done)) (goto-char pnt))) -(defun bibtex-convert-alien (&optional do-additional-reformatting) +(defun bibtex-convert-alien (&optional read-options) "Convert an alien BibTeX buffer to be fully usable by BibTeX mode. -If a file does not conform with some standards used by BibTeX mode, +If a file does not conform with all standards used by BibTeX mode, some of the high-level features of BibTeX mode will not be available. This function tries to convert current buffer to conform with these standards. -With prefix argument DO-ADDITIONAL-REFORMATTING -non-nil, read options for reformatting entries from minibuffer." +With prefix argument READ-OPTIONS non-nil, read options for reformatting +entries from minibuffer." (interactive "*P") (message "Starting to validate buffer...") (sit-for 1 nil t) - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]+@" nil t) - (replace-match "\n@")) + (bibtex-realign) (message "If errors occur, correct them and call `bibtex-convert-alien' again") (sit-for 5 nil t) @@ -3714,10 +3738,7 @@ non-nil, read options for reformatting entries from minibuffer." (bibtex-validate)) (message "Starting to reformat entries...") (sit-for 2 nil t) - (bibtex-reformat do-additional-reformatting t) - (when bibtex-maintain-sorted-entries - (message "Starting to sort buffer...") - (bibtex-sort-buffer)) + (bibtex-reformat read-options) (goto-char (point-max)) (message "Buffer is now parsable. Please save it."))) @@ -3890,5 +3911,5 @@ is outside key or BibTeX field." (provide 'bibtex) -;;; arch-tag: ee2be3af-caad-427f-b42a-d20fad630d04 +;; arch-tag: ee2be3af-caad-427f-b42a-d20fad630d04 ;;; 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." (tool-bar-add-item-from-menu 'undo "undo" nil :visible '(not (eq 'special (get major-mode 'mode-class)))) - (tool-bar-add-item-from-menu 'kill-region "cut" nil + (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [cut]) + "cut" nil :visible '(not (eq 'special (get major-mode 'mode-class)))) - (tool-bar-add-item-from-menu 'menu-bar-kill-ring-save "copy") - (tool-bar-add-item-from-menu 'yank "paste" nil + (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [copy]) + "copy") + (tool-bar-add-item-from-menu (lookup-key menu-bar-edit-menu [paste]) + "paste" nil :visible '(not (eq 'special (get major-mode 'mode-class)))) (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'." (buffer-enable-undo) ; Performance hack. See above. (set-buffer-modified-p nil) (setq buffer-undo-list nil) - (run-hooks wdired-mode-hook) - (message "Press C-c C-c when finished")) + (run-hooks 'wdired-mode-hook) + (message (substitute-command-keys "Press \\[wdired-finish-edit] when finished"))) ;; Protect the buffer so only the filenames can be changed, and put @@ -416,7 +416,8 @@ non-nil means return old filename." (insert wdired-old-content)) (wdired-change-to-dired-mode) (set-buffer-modified-p nil) - (setq buffer-undo-list nil)) + (setq buffer-undo-list nil) + (message "Changes aborted")) (defun wdired-finish-edit () "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 @@ ;;; winner.el --- Restore old window configurations -;; Copyright (C) 1997, 1998, 2001 Free Software Foundation. Inc. +;; Copyright (C) 1997, 1998, 2001, 2004 Free Software Foundation. Inc. ;; Author: Ivar Rummelhoff <ivarru@math.uio.no> ;; Created: 27 Feb 1997 @@ -30,8 +30,8 @@ ;; window configuration (i.e. how the frames are partitioned into ;; windows) so that the changes can be "undone" using the command ;; `winner-undo'. By default this one is bound to the key sequence -;; ctrl-x left. If you change your mind (while undoing), you can -;; press ctrl-x right (calling `winner-redo'). Even though it uses +;; ctrl-c left. If you change your mind (while undoing), you can +;; press ctrl-c right (calling `winner-redo'). Even though it uses ;; some features of Emacs20.3, winner.el should also work with ;; Emacs19.34 and XEmacs20, provided that the installed version of ;; custom is not obsolete. @@ -474,8 +474,8 @@ In other words, \"undo\" changes in window configuration." (unless winner-mode-map (setq winner-mode-map (make-sparse-keymap)) - (define-key winner-mode-map [(control x) left] 'winner-undo) - (define-key winner-mode-map [(control x) right] 'winner-redo)) + (define-key winner-mode-map [(control c) left] 'winner-undo) + (define-key winner-mode-map [(control c) right] 'winner-redo)) (unless (or (assq 'winner-mode minor-mode-map-alist) 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." (provide 'xml) -;;; arch-tag: 5864b283-5a68-4b59-a20d-36a72b353b9b +;; arch-tag: 5864b283-5a68-4b59-a20d-36a72b353b9b ;;; xml.el ends here |