diff options
Diffstat (limited to 'lisp')
58 files changed, 2147 insertions, 1283 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 554aec1cd7a..eef41ee9394 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,465 @@ +2005-12-01 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-ann3): Bind mouse-2 to gdb-mouse-until + in the margin also. + (gdb-breakpoints-mode-map): Use D instead of d for + gdb-delete-breakpoint. + (gdb-get-frame-number): Require a number to match on. + (gdb-threads-mode-map): Add follow-link binding. + +2005-11-30 Jason Rumney <jasonr@gnu.org> + + * isearch.el (isearch-mode-map): Avoid exiting search on + language-change event. + +2005-11-30 Romain Francoise <romain@orebokech.com> + + * speedbar.el (speedbar-default-position): New defcustom. + (speedbar-frame-reposition-smartly): Use it. + + * dframe.el (dframe-reposition-frame-emacs): Fix position + computation for 'left location. + Update copyright year. + +2005-11-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * help.el (help-map): Move initialization into declaration. + + * emacs-lisp/autoload.el (make-autoload): Handle defgroup specially. + + * help-fns.el (help-argument-name): Don't autoload. + It's useless and triggers a bug in cus-dep.el causing ldefs-boot + to be re-loaded when customizing the `help' group. + +2005-11-30 John Paul Wallington <jpw@gnu.org> + + * help-fns.el (describe-function-1): Fill arglist output. + +2005-11-30 Kim F. Storm <storm@cua.dk> + + * emulation/cua-rect.el (cua--rectangle-overlays): Make permanent-local. + (cua--rectangle-post-command): Cleanup overlays and deactivate mark + after revert-buffer (or anything else which kills all local variables). + + * apropos.el (apropos-parse-pattern): Doc fix. + Set apropos-regexp directly, rather than expecting callers to do so. + (apropos-command, apropos, apropos-value, apropos-documentation): + Simplify calls to apropos-parse-pattern. + +2005-11-29 Chong Yidong <cyd@stupidchicken.com> + + * hi-lock.el (hi-lock-line-face-buffer, hi-lock-face-buffer) + (hi-lock-face-phrase-buffer): Use hi-yellow face. + (hi-lock-write-interactive-patterns): Use comment-region. + + * longlines.el (longlines-mode): Add mail-setup-hook. + + * mail/mailheader.el, mail/sendmail.el: Revert 2005-11-17 changes. + + * simple.el (sendmail-user-agent-compose, next-line): + Conditionally use hard-newline. + +2005-11-29 Reiner Steib <Reiner.Steib@gmx.de> + + * international/latexenc.el (latex-inputenc-coding-alist): + Reword doc string. + +2005-11-29 Chong Yidong <cyd@stupidchicken.com> + + * help.el (describe-key-briefly, describe-key): Recognize default + bindings. + +2005-11-29 Romain Francoise <romain@orebokech.com> + + * view.el (view-inhibit-help-message): New defcustom. + (view-mode-enter): Use it. + +2005-11-29 Michael Kifer <kifer@cs.stonybrook.edu> + + * ediff-wind (ediff-setup-control-frame, ediff-make-wide-display): + Preserve user position. + +2005-11-28 Luc Teirlinck <teirllm@auburn.edu> + + * font-lock.el: Throw error if facemenu is not loaded to prevent + accidental change of loading order in loadup.el. (Suggested by RMS.) + + * loadup.el: Add comment explaining why facemenu must be loaded + before font-lock. + +2005-11-28 Jay Belanger <belanger@truman.edu> + + * calc/calc.el: Change global keybinding for calc-dispatch to "\C-x*". + (calc-dispatch-map): Add more keys for `calc-same-interface'. + + * calc/calc-misc.el (calc-dispatch-help): Update docstring. + + * calc/calc-embed.el (calc-do-embedded): Update help message. + + * calc/calc-prog.el (calc-user-define-invokation): Update help message. + +2005-11-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * log-edit.el (log-edit-insert-cvs-rcstemplate): Ignore stderr. + + * emacs-lisp/elp.el (elp-not-profilable): Replace interactive-p with + called-interactively-p. + (elp-profilable-p): Rename from elp-not-profilable-p. + Invert result and take into account macros and autoloaded functions. + (elp-instrument-function): Update call. + (elp-instrument-package): Update call. Add completion. + (elp-pack-number): Use match-string. + (elp-results-jump-to-definition-by-mouse): Merge into + elp-results-jump-to-definition and then remove. + (elp-output-insert-symname): Make help echo text single-line. + + * replace.el (query-replace-map): Move initialization into declaration. + (occur-engine): Use with-current-buffer. + (occur-mode-goto-occurrence): Make it work for mouse-clicks as well. + (occur-mode-mouse-goto): Replace with an alias. + +2005-11-28 Juri Linkov <juri@jurta.org> + + * simple.el (quoted-insert): Let-bind input-method-function to nil. + + * term/w32-win.el: Bind [S-tab] to [backtab]. + + * info.el (Info-fontify-node): Set 2nd arg `noerror' of + `Info-find-file' to t. + + * replace.el (occur-mode-mouse-goto): Pop, don't switch. + (occur-mode-goto-occurrence): Let-bind same-window-buffer-names + and same-window-regexps. + (occur-next-error): Don't move point for arg 0. + +2005-11-28 Chong Yidong <cyd@stupidchicken.com> + + * replace.el (occur-mode-goto-occurrence): Pop, don't switch. + +2005-11-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * log-edit.el (log-edit-changelog-use-first): New var. + (log-edit-changelog-ours-p): Use it. + (log-edit-insert-changelog): Set it with new arg `use-first'. + (log-edit-insert-cvs-rcstemplate, log-edit-insert-filenames): New funs. + (log-edit-hook): Add them to the list of suggested options. + + * textmodes/flyspell.el (flyspell-last-buffer): New var. + (flyspell-accept-buffer-local-defs): Use it to avoid doing silly + redundant work. + (flyspell-mode-on): Use add-hook for after-change-functions. + (flyspell-mode-off): Use remove-hook for after-change-functions. + (flyspell-changes): Make it buffer-local. + (flyspell-after-change-function): Make it non-interactive. Use push. + (flyspell-post-command-hook): Check input-pending-p while processing + the potentially long list of buffer changes. + +2005-11-28 L$,1 q(Brentey K,Aa(Broly <lorentey@elte.hu> + + * buff-menu.el (list-buffers-noselect): Display the selected + frame's buffer list, not the global one. + +2005-11-28 Nick Roberts <nickrob@snap.net.nz> + + * xt-mouse.el (xterm-mouse-event): Set last-input-event so + that (list last-input-event) works as in interactive spec. + +2005-11-27 Luc Teirlinck <teirllm@auburn.edu> + + * loadup.el ("facemenu"): Load facemenu before font-lock, because + `facemenu-keymap' needs to be defined when font-lock is loaded. + Otherwise, `M-o M-o' is not bound to `font-lock-fontify-block'. + +2005-11-27 Stefan Monnier <monnier@iro.umontreal.ca> + + * completion.el: Remove useless leading * in defcustom docstrings. + (save-completions-file-name): Use ~/.emacs.d if available. + (completion-standard-syntax-table): Rename from + cmpl-standard-syntax-table and fold initialization into declaration, + thus removing cmpl-make-standard-completion-syntax-table. + (completion-lisp-syntax-table, completion-c-syntax-table) + (completion-fortran-syntax-table, completion-c-def-syntax-table): Idem. + (cmpl-saved-syntax, cmpl-saved-point): Remove. + (symbol-under-point, symbol-before-point) + (symbol-under-or-before-point, symbol-before-point-for-complete) + (add-completions-from-c-buffer): Use with-syntax-table. + (make-completion): Don't return a list of completion entries. + Update callers. + (cmpl-prefix-entry-head, cmpl-prefix-entry-tail): Use defalias. + (completion-initialize): Rename from initialize-completions. + (completion-find-file-hook): Rename from cmpl-find-file-hook. + (kill-emacs-save-completions): Collect stats here. + (save-completions-to-file, load-completions-from-file): + Use with-current-buffer. + (completion-def-wrapper): Rename from def-completion-wrapper. Make it + into a function. Move all calls to toplevel. + (completion-lisp-mode-hook): New fun. + (completion-c-mode-hook, completion-setup-fortran-mode): + Set the syntax-table here. Use local-set-key. + (completion-saved-bindings): New var. + (dynamic-completion-mode): Make it into a proper minor mode. + (load-completions-from-file): Remove unused var `num-uses'. + + * emacs-lisp/cl-macs.el (defstruct): Don't define the default + constructor if it is explicitly overridden. + + * complete.el (PC-completion-as-file-name-predicate): + Use minibuffer-completing-file-name. + (partial-completion-mode): Use find-file-not-found-functions. + (PC-lisp-complete-symbol): Use with-syntax-table. + (PC-look-for-include-file): Remove dead setq. + (PC-look-for-include-file, PC-expand-many-files, PC-do-completion) + (PC-complete): Use with-current-buffer. + + * progmodes/sh-script.el (sh-font-lock-syntactic-keywords): \ doesn't + escape single quotes. + +2005-11-27 Luc Teirlinck <teirllm@auburn.edu> + + * dabbrev.el (dabbrev-completion): Simplify code, by getting rid + of `if' whose condition always returned nil. Doc fix. + + * buff-menu.el (Buffer-menu-revert-function): Make the selected + window's buffer the current buffer around the call to + `list-buffers-noselect'. This is necessary to mark that buffer + with a `.' in the Buffer Menu when called from Lisp, for instance + by Auto Revert Mode. + +2005-11-28 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-stopped): Detect child process when + attaching to it. + (gdb-pre-prompt): Make sure gdb-error is reset. + + * progmodes/gud.el (gud-gdb-marker-filter): When GDB is invoked + with a child process, detect it. + (gud-speedbar-buttons): Match regexp more carefully. + +2005-11-27 Richard M. Stallman <rms@gnu.org> + + * mouse.el (mouse-drag-move-window-bottom): + Use adjust-window-trailing-edge. + +2005-11-27 Luc Teirlinck <teirllm@auburn.edu> + + * simple.el (blink-matching-open): Ignore + `blink-matching-paren-on-screen' if `show-paren-mode' is enabled. + (blink-matching-paren-on-screen): Update docstring. + + * paren.el (show-paren-mode): No longer change + `blink-matching-paren-on-screen'. + +2005-11-27 John Paul Wallington <jpw@pobox.com> + + * progmodes/gdb-ui.el (gdb-goto-breakpoint, gdb-frames-select) + (gdb-threads-select, gdb-edit-register-value): + Use `posn-set-point' instead of `mouse-set-point' because the + latter is not fbound when configured without X. + +2005-11-27 Kim F. Storm <storm@cua.dk> + + * emulation/cua-rect.el (cua--highlight-rectangle): Preserve + existing face when partially highlighting a TAB in a rectangle. + +2005-11-26 Kim F. Storm <storm@cua.dk> + + * ido.el (ido-mode-map): Doc fix. + (ido-mode-common-map, ido-mode-file-map) + (ido-mode-file-dir-map, ido-mode-buffer-map): New keymaps. + (ido-define-mode-map): Rewrite. Select one of the new maps as + parent for ido-mode-map instead of building from scratch. + (ido-init-mode-maps): New defun to initialize new maps. + (ido-mode): Call it. + (ido-switch-buffer): Doc fix -- use \<ido-mode-buffer-map>. + (ido-find-file): Doc fix -- use \<ido-mode-file-map>. + +2005-11-26 John Paul Wallington <jpw@pobox.com> + + * arc-mode.el (archive-extract): Use `posn-set-point' instead of + `mouse-set-point' because the latter is not fbound when configured + without X. + +2005-11-26 Thien-Thi Nguyen <ttn@gnu.org> + + * files.el (file-relative-name): Doc fix. + +2005-11-26 Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> + + * progmodes/octave-inf.el (inferior-octave-startup): Force a + non-empty string for secondary prompt PS2. + +2005-11-25 Chong Yidong <cyd@stupidchicken.com> + + * progmodes/compile.el (compilation-setup): Fix last change. + +2005-11-26 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-info-breakpoints-custom) + (gdb-mouse-toggle-breakpoint-margin) + (gdb-mouse-toggle-breakpoint-fringe, gdb-threads-select): + Add gdb-server-prefix to keep out of command history. + (gdb-edit-register-value): New function. + (gdb-registers-mode-map): Bind mouse-2 and RET to it. + (gdb-info-registers-custom): Use above map. + +2005-11-25 Chong Yidong <cyd@stupidchicken.com> + + * custom.el (enable-theme): Signal error if argument is not a + theme. Don't recalculate a face if it's not loaded yet. + + * cus-face.el (custom-theme-set-faces): Don't change saved-face if + the `user' theme is in effect. + + * info.el (Info-on-current-buffer): Record actual filename in + Info-current-file, instead of t, or a fake filename if a non-file + buffer. Make autoload. + (Info-find-node, Info-revert-find-node): No need to check for + Info-current-file nil. + (Info-set-mode-line, Info-up, Info-copy-current-node-name): + Info-current-file is now never `t'. + (Info-fontify-node): Many simplifications due to Info-current-file + always being valid. Use Info-find-file to find node filename. + +2005-11-25 David Kastrup <dak@gnu.org> + + * longlines.el (longlines-wrap-line): Reorder wrapping to "insert + new character, then delete" in order to preserve markers. + +2005-11-25 David Ponce <david@dponce.com> + + * recentf.el (recentf-arrange-by-rule): Handle a special + `auto-mode-alist'-like "strip suffix" rule. + (recentf-build-mode-rules): Handle second level auto-mode entries. + +2005-11-25 Michael Kifer <kifer@cs.stonybrook.edu> + + * viper-keym.el (viper-ESC-key): Use different values in terminal and + window modes. + + * viper.el (viper-emacs-state-mode-list): Delete mail-mode, add + jde-javadoc-checker-report-mode. + + * ediff-wind (ediff-make-wide-display): Slight simplification. + + * ediff.el (ediff-date): Change the date of last update. + +2005-11-24 Chong Yidong <cyd@stupidchicken.com> + + * hi-lock.el (hi-lock-buffer-mode): Renamed from `hi-lock-mode'. + Use define-minor-mode, and make it a local mode. Turn on font-lock. + (hi-lock-mode): New global minor mode. + (turn-on-hi-lock-if-enabled): New function. + (hi-lock-line-face-buffer, hi-lock-face-buffer, hi-lock-set-pattern): + Change arguments to regexp and face instead of a font-lock pattern. + Directly set face property, instead of refontifying. + (hi-lock-font-lock-hook): Check if font-lock is being turned on. + (hi-lock-find-patterns): Use line-number-at-pos. + + (hi-lock-face-phrase-buffer): Call hi-lock-buffer-mode. Use new + arguments for hi-lock-set-pattern. + (hi-lock-unface-buffer, hi-lock-set-file-patterns): Call + font-lock-fontify-buffer. + (hi-lock-find-file-hook, hi-lock-current-line) + (hi-lock-refontify, hi-lock-set-patterns): Delete unused functions. + + (hi-lock-font-lock-hook): Turn off hi-lock when font lock is + turned off. + + * progmodes/compile.el (compilation-setup): Don't fiddle with + font-lock-defaults. + +2005-11-25 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-var-create-handler) + (gdb-var-list-children-handler): Find values for all variable + objects. gud-speedbar-buttons decides whether to display them. + +2005-11-24 Romain Francoise <romain@orebokech.com> + + * info.el (Info-speedbar-fetch-file-nodes): Prefix temporary + buffer name with a space. + +2005-11-24 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: (org-export-plain-list-max-depth): Renamed from + `org-export-local-list-max-depth'. Change default value to 3. + (org-auto-renumber-ordered-lists) + (org-plain-list-ordered-item-terminator): New options. + (org-at-item-p, org-beginning-of-item, org-end-of-item) + (org-get-indentation, org-get-string-indentation) + (org-maybe-renumber-ordered-list, org-renumber-ordered-list): New + functions. + (org-move-item-down, org-move-item-up): New commands. + (org-export-as-html): New classes for CSS support. Bug fix in + regular expression detecting fixed-width regions. Respect + `org-local-list-ordered-item-terminator'. + (org-set-autofill-regexps, org-adaptive-fill-function): "1)" is + also a list item. + (org-metaup, org-metadown, org-shiftmetaup, org-shiftmetadown): + New item moving functions. + +2005-11-24 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-repeat): With empty search ring set + `isearch-error' to the error string instead of signaling error + with the function `error'. + +2005-11-24 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * term/mac-win.el: Make modifier `ctrl' an alias for `control'. + +2005-11-24 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-speedbar-auto-raise): New function + and variable. + (gdb-var-create-handler, gdb-var-list-children-handler): + Don't match on "char **...". + (gdb-var-update-handler): Find values for all variable objects. + (gdb-info-frames-custom): Identify frames by leading "#". + + * progmodes/gud.el (gud-speedbar-menu-items): Add + gdb-speedbar-auto-raise as radio button. + (gud-speedbar-buttons): Raise speedbar if requested. + Don't match on "char **...". + (gud-speedbar-buttons): Add (pointer) value for non-leaves. + Make it editable. + +2005-11-23 Chong Yidong <cyd@stupidchicken.com> + + * info.el (Info-fontify-node): Handle the case where + Info-current-file is t. + +2005-11-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (blink-matching-open): Fix off-by-one in last change. + +2005-11-23 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * term/mac-win.el: Don't change default directory. + +2005-11-22 Luc Teirlinck <teirllm@auburn.edu> + + * cus-edit.el (Custom-reset-standard): Make it handle Custom group + buffers correctly. (It used to throw an error in such buffers.) + Make it ask for confirmation in group buffers and other Custom + buffers containing more than one customization item. + +2005-11-22 John Paul Wallington <jpw@gnu.org> + + * net/goto-addr.el (goto-address-fontify): Put `follow-link' + property on mail and url overlays. + (goto-address-at-point): Use `posn-set-point' instead of + `mouse-set-point' because the latter is not fbound when configured + without X. + +2005-11-22 Lars Hansen <larsh@soem.dk> + + * ls-lisp.el (ls-lisp-parse-symlink): Delete. + (ls-lisp-classify, ls-lisp-format): Delete call to + ls-lisp-parse-symlink. + (ls-lisp-handle-switches): Handle symlinks to directories as + directories when ls-lisp-dirs-first in non-nil. + 2005-11-21 Luc Teirlinck <teirllm@auburn.edu> * startup.el (command-line): Make sure that loaddefs.el is handled @@ -37,6 +499,12 @@ * faces.el: Revert 2005-11-17 change. :ignore-defface is now handled automagically. +2005-11-20 Andreas Schwab <schwab@suse.de> + + * descr-text.el (describe-char): When copying overlays put them + over the full char description instead of just the first character + of it. + 2005-11-20 Juri Linkov <juri@jurta.org> * simple.el (what-cursor-position): diff --git a/lisp/apropos.el b/lisp/apropos.el index 5eda7567ef0..4e5109c1efb 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -301,7 +301,9 @@ kind of objects to search." (defun apropos-parse-pattern (pattern) "Rewrite a list of words to a regexp matching all permutations. -If PATTERN is a string, that means it is already a regexp." +If PATTERN is a string, that means it is already a regexp. +This updates variables `apropos-pattern', `apropos-pattern-quoted', +`apropos-regexp', `apropos-words', and `apropos-all-words-regexp'." (setq apropos-words nil apropos-all-words nil) (if (consp pattern) @@ -325,11 +327,14 @@ If PATTERN is a string, that means it is already a regexp." (setq syn (cdr syn)))) (setq apropos-words (cons s apropos-words) apropos-all-words (cons a apropos-all-words)))) - (setq apropos-all-words-regexp (apropos-words-to-regexp apropos-all-words ".+")) - (apropos-words-to-regexp apropos-words ".*?")) + (setq apropos-all-words-regexp + (apropos-words-to-regexp apropos-all-words ".+")) + (setq apropos-regexp + (apropos-words-to-regexp apropos-words ".*?"))) (setq apropos-pattern-quoted (regexp-quote pattern) apropos-all-words-regexp pattern - apropos-pattern pattern))) + apropos-pattern pattern + apropos-regexp pattern))) (defun apropos-calc-scores (str words) @@ -442,7 +447,7 @@ while a list of strings is used as a word list." (if (or current-prefix-arg apropos-do-all) "command or function" "command")) current-prefix-arg)) - (setq apropos-regexp (apropos-parse-pattern pattern)) + (apropos-parse-pattern pattern) (let ((message (let ((standard-output (get-buffer-create "*Apropos*"))) (print-help-return-message 'identity)))) @@ -508,7 +513,7 @@ show unbound symbols and key bindings, which is a little more time-consuming. Returns list of symbols and documentation found." (interactive (list (apropos-read-pattern "symbol") current-prefix-arg)) - (setq apropos-regexp (apropos-parse-pattern pattern)) + (apropos-parse-pattern pattern) (apropos-symbols-internal (apropos-internal apropos-regexp (and (not do-all) @@ -577,7 +582,7 @@ at the function and at the names and values of properties. Returns list of symbols and values found." (interactive (list (apropos-read-pattern "value") current-prefix-arg)) - (setq apropos-regexp (apropos-parse-pattern pattern)) + (apropos-parse-pattern pattern) (or do-all (setq do-all apropos-do-all)) (setq apropos-accumulator ()) (let (f v p) @@ -623,7 +628,7 @@ bindings. Returns list of symbols and documentation found." (interactive (list (apropos-read-pattern "documentation") current-prefix-arg)) - (setq apropos-regexp (apropos-parse-pattern pattern)) + (apropos-parse-pattern pattern) (or do-all (setq do-all apropos-do-all)) (setq apropos-accumulator () apropos-files-scanned ()) (let ((standard-input (get-buffer-create " apropos-temp")) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index ae5ff9a4dbc..c376070ea3b 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -895,7 +895,7 @@ using `make-temp-file', and the generated name is returned." (defun archive-extract (&optional other-window-p event) "In archive mode, extract this entry of the archive into its own buffer." (interactive (list nil last-input-event)) - (if event (mouse-set-point event)) + (if event (posn-set-point (event-end event))) (let* ((view-p (eq other-window-p 'view)) (descr (archive-get-descr)) (ename (aref descr 0)) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index e48aa9e34b4..818fc19a4fd 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -210,7 +210,12 @@ Letters do not insert themselves; instead, they are commands. (prop (point-min)) ;; do not make undo records for the reversion. (buffer-undo-list t)) - (list-buffers-noselect Buffer-menu-files-only) + ;; We can be called by Auto Revert Mode with the "*Buffer Menu*" + ;; temporarily the current buffer. Make sure that the + ;; interactively current buffer is correctly identified with a `.' + ;; by `list-buffers-noselect'. + (with-current-buffer (window-buffer) + (list-buffers-noselect Buffer-menu-files-only)) (if oline (while (setq prop (next-single-property-change prop 'buffer)) (when (eq (get-text-property prop 'buffer) oline) @@ -717,7 +722,7 @@ For more information, see the function `buffer-menu'." (if (memq c '(?\n ?\s)) c underline)) header))))) ;; Collect info for every buffer we're interested in. - (dolist (buffer (or buffer-list (buffer-list))) + (dolist (buffer (or buffer-list (buffer-list (selected-frame)))) (with-current-buffer buffer (let ((name (buffer-name)) (file buffer-file-name)) diff --git a/lisp/calc/calc-embed.el b/lisp/calc/calc-embed.el index 4127c0b33da..7878034694e 100644 --- a/lisp/calc/calc-embed.el +++ b/lisp/calc/calc-embed.el @@ -315,7 +315,7 @@ (or (eq calc-embedded-quiet t) (message "Embedded Calc mode enabled; %s to return to normal" (if calc-embedded-quiet - "Type `M-# x'" + "Type `C-x * x'" "Give this command again"))))) (scroll-down 0)) ; fix a bug which occurs when truncate-lines is changed. diff --git a/lisp/calc/calc-misc.el b/lisp/calc/calc-misc.el index ba80f455b4f..ca8e8bbdbfe 100644 --- a/lisp/calc/calc-misc.el +++ b/lisp/calc/calc-misc.el @@ -33,7 +33,7 @@ (require 'calc-macs) (defun calc-dispatch-help (arg) - "M-# is a prefix key; follow it with one of these letters: + "C-x* is a prefix key sequence; follow it with one of these letters: For turning Calc on and off: C calc. Start the Calculator in a window at the bottom of the screen. @@ -73,8 +73,9 @@ Miscellaneous: M read-kbd-macro. Read a region of keystroke names as a keyboard macro. 0 (zero) calc-reset. Reset Calc stack and modes to default state. -Press twice (`M-# M-#' or `M-# #') to turn Calc on or off using the same -Calc user interface as before (either M-# C or M-# K; initially M-# C)." +Press `*' twice (`C-x * *') to turn Calc on or off using the same +Calc user interface as before (either C-x * C or C-x * K; initially C-x * C). +" (interactive "P") (calc-check-defines) (if calc-dispatch-help diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el index 2bbbbcceee5..8736d4375dd 100644 --- a/lisp/calc/calc-prog.el +++ b/lisp/calc/calc-prog.el @@ -667,7 +667,7 @@ (or last-kbd-macro (error "No keyboard macro defined")) (setq calc-invocation-macro last-kbd-macro) - (message "Use `M-# Z' to invoke this macro")) + (message "Use `C-x * Z' to invoke this macro")) (defun calc-user-define-edit () (interactive) ; but no calc-wrapper! diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index bd161132ddf..fe55b7587f3 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -816,11 +816,6 @@ If nil, selections displayed but ignored.") ;; Verify that Calc is running on the right kind of system. (defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version)))) -;; Set up the standard keystroke (M-#) to run the Calculator, if that key -;; has not yet been bound to anything. For best results, the user should -;; do this before Calc is even loaded, so that M-# can auto-load Calc. -(or (global-key-binding "\e#") (global-set-key "\e#" 'calc-dispatch)) - ;; Set up the autoloading linkage. (let ((name (and (fboundp 'calc-dispatch) (eq (car-safe (symbol-function 'calc-dispatch)) 'autoload) @@ -1046,14 +1041,20 @@ If nil, selections displayed but ignored.") ( ?x . calc-quit ) ( ?y . calc-copy-to-buffer ) ( ?z . calc-user-invocation ) - ( ?= . calc-embedded-update-formula ) ( ?\' . calc-embedded-new-formula ) ( ?\` . calc-embedded-edit ) ( ?: . calc-grab-sum-down ) ( ?_ . calc-grab-sum-across ) ( ?0 . calc-reset ) + ( ?? . calc-dispatch-help ) ( ?# . calc-same-interface ) - ( ?? . calc-dispatch-help ) )) + ( ?& . calc-same-interface ) + ( ?\\ . calc-same-interface ) + ( ?= . calc-same-interface ) + ( ?* . calc-same-interface ) + ( ?/ . calc-same-interface ) + ( ?+ . calc-same-interface ) + ( ?- . calc-same-interface ) )) map)) ;;;; (Autoloads here) @@ -1095,7 +1096,7 @@ If nil, selections displayed but ignored.") report-calc-bug))) -;;;###autoload (global-set-key "\e#" 'calc-dispatch) +;;;###autoload (define-key ctl-x-map "*" 'calc-dispatch) ;;;###autoload (defun calc-dispatch (&optional arg) @@ -3534,7 +3535,7 @@ Also looks for the equivalent TeX words, \\gets and \\evalto." (defun calc-user-invocation () (interactive) (unless calc-invocation-macro - (error "Use `Z I' inside Calc to define a `M-# Z' keyboard macro")) + (error "Use `Z I' inside Calc to define a `C-x * Z' keyboard macro")) (execute-kbd-macro calc-invocation-macro nil)) ;;; User-programmability. diff --git a/lisp/complete.el b/lisp/complete.el index 4a2ce48f152..f5ab178e1b3 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -216,9 +216,9 @@ the *Completions* buffer." (PC-bindings partial-completion-mode) ;; Deal with include file feature... (cond ((not partial-completion-mode) - (remove-hook 'find-file-not-found-hooks 'PC-look-for-include-file)) + (remove-hook 'find-file-not-found-functions 'PC-look-for-include-file)) ((not PC-disable-includes) - (add-hook 'find-file-not-found-hooks 'PC-look-for-include-file))) + (add-hook 'find-file-not-found-functions 'PC-look-for-include-file))) ;; ... with some underhand redefining. (cond ((and (not partial-completion-mode) (functionp PC-old-read-file-name-internal)) @@ -261,8 +261,7 @@ Word-delimiters for the purposes of Partial Completion are \"-\", \"_\", ;; and this command is repeated, scroll that window. (if (and window (window-buffer window) (buffer-name (window-buffer window))) - (save-excursion - (set-buffer (window-buffer window)) + (with-current-buffer (window-buffer window) (if (pos-visible-in-window-p (point-max) window) (set-window-start window (point-min) nil) (scroll-other-window))) @@ -346,11 +345,8 @@ See `PC-complete' for details." (defvar PC-delims-list nil) (defvar PC-completion-as-file-name-predicate - (function - (lambda () - (memq minibuffer-completion-table - '(read-file-name-internal read-directory-name-internal)))) - "A function testing whether a minibuffer completion now will work filename-style. + (lambda () minibuffer-completing-file-name) + "A function testing whether a minibuffer completion now will work filename-style. The function takes no arguments, and typically looks at the value of `minibuffer-completion-table' and the minibuffer contents.") @@ -665,8 +661,7 @@ of `minibuffer-completion-table' and the minibuffer contents.") (eq mode 'help)) (with-output-to-temp-buffer "*Completions*" (display-completion-list (sort helpposs 'string-lessp)) - (save-excursion - (set-buffer standard-output) + (with-current-buffer standard-output ;; Record which part of the buffer we are completing ;; so that choosing a completion from the list ;; knows how much old text to replace. @@ -732,16 +727,12 @@ Otherwise, all symbols with function definitions, values or properties are considered." (interactive) (let* ((end (point)) - (buffer-syntax (syntax-table)) - (beg (unwind-protect - (save-excursion - (if lisp-mode-syntax-table - (set-syntax-table lisp-mode-syntax-table)) - (backward-sexp 1) - (while (= (char-syntax (following-char)) ?\') - (forward-char 1)) - (point)) - (set-syntax-table buffer-syntax))) + (beg (save-excursion + (with-syntax-table lisp-mode-syntax-table + (backward-sexp 1) + (while (= (char-syntax (following-char)) ?\') + (forward-char 1)) + (point)))) (minibuffer-completion-table obarray) (minibuffer-completion-predicate (if (eq (char-after (1- beg)) ?\() @@ -767,12 +758,11 @@ or properties are considered." (goto-char end) (PC-do-completion nil beg end))) -;;; Use the shell to do globbing. -;;; This could now use file-expand-wildcards instead. +;; Use the shell to do globbing. +;; This could now use file-expand-wildcards instead. (defun PC-expand-many-files (name) - (save-excursion - (set-buffer (generate-new-buffer " *Glob Output*")) + (with-current-buffer (generate-new-buffer " *Glob Output*") (erase-buffer) (shell-command (concat "echo " name) t) (goto-char (point-min)) @@ -804,9 +794,9 @@ or properties are considered." (setq files (cdr files))) p)))) -;;; Facilities for loading C header files. This is independent from the -;;; main completion code. See also the variable `PC-include-file-path' -;;; at top of this file. +;; Facilities for loading C header files. This is independent from the +;; main completion code. See also the variable `PC-include-file-path' +;; at top of this file. (defun PC-look-for-include-file () (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name)) @@ -817,8 +807,7 @@ or properties are considered." new-buf) (kill-buffer (current-buffer)) (if (equal name "") - (save-excursion - (set-buffer (car (buffer-list))) + (with-current-buffer (car (buffer-list)) (save-excursion (beginning-of-line) (if (looking-at @@ -855,8 +844,7 @@ or properties are considered." (if path (setq name (concat (file-name-as-directory (car path)) name)) (error "No such include file: <%s>" name))) - (let ((dir (save-excursion - (set-buffer (car (buffer-list))) + (let ((dir (with-current-buffer (car (buffer-list)) default-directory))) (if (file-exists-p (concat dir name)) (setq name (concat dir name)) @@ -865,8 +853,7 @@ or properties are considered." (if new-buf ;; no need to verify last-modified time for this! (set-buffer new-buf) - (setq new-buf (create-file-buffer name)) - (set-buffer new-buf) + (set-buffer (create-file-buffer name)) (erase-buffer) (insert-file-contents name t)) ;; Returning non-nil with the new buffer current @@ -885,7 +872,7 @@ or properties are considered." env (substring env 0 pos))) path))) -;;; This is adapted from lib-complete.el, by Mike Williams. +;; This is adapted from lib-complete.el, by Mike Williams. (defun PC-include-file-all-completions (file search-path &optional full) "Return all completions for FILE in any directory on SEARCH-PATH. If optional third argument FULL is non-nil, returned pathnames should be diff --git a/lisp/completion.el b/lisp/completion.el index 12df9a52714..2cd30e6513f 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -82,11 +82,11 @@ ;; SAVING/LOADING COMPLETIONS ;; Completions are automatically saved from one session to another ;; (unless save-completions-flag or enable-completion is nil). -;; Loading this file (or calling initialize-completions) causes EMACS +;; Activating this minor-mode calling completion-initialize) causes Emacs ;; to load a completions database for a saved completions file -;; (default: ~/.completions). When you exit, EMACS saves a copy of the +;; (default: ~/.completions). When you exit, Emacs saves a copy of the ;; completions that you -;; often use. When you next start, EMACS loads in the saved completion file. +;; often use. When you next start, Emacs loads in the saved completion file. ;; ;; The number of completions saved depends loosely on ;; *saved-completions-decay-factor*. Completions that have never been @@ -141,8 +141,8 @@ ;; App --> Appropriately] ;; ;; INITIALIZATION -;; The form `(initialize-completions)' initializes the completion system by -;; trying to load in the user's completions. After the first cal, further +;; The form `(completion-initialize)' initializes the completion system by +;; trying to load in the user's completions. After the first call, further ;; calls have no effect so one should be careful not to put the form in a ;; site's standard site-init file. ;; @@ -180,7 +180,7 @@ ;; complete ;; Inserts a completion at point ;; -;; initialize-completions +;; completion-initialize ;; Loads the completions file and sets up so that exiting emacs will ;; save them. ;; @@ -286,59 +286,65 @@ (defcustom enable-completion t - "*Non-nil means enable recording and saving of completions. + "Non-nil means enable recording and saving of completions. If nil, no new words are added to the database or saved to the init file." :type 'boolean :group 'completion) (defcustom save-completions-flag t - "*Non-nil means save most-used completions when exiting Emacs. + "Non-nil means save most-used completions when exiting Emacs. See also `save-completions-retention-time'." :type 'boolean :group 'completion) -(defcustom save-completions-file-name (convert-standard-filename "~/.completions") - "*The filename to save completions to." +(defcustom save-completions-file-name + (let ((olddef (convert-standard-filename "~/.completions"))) + (cond + ((file-readable-p olddef) olddef) + ((file-directory-p (convert-standard-filename "~/.emacs.d/")) + (convert-standard-filename (expand-file-name completions "~/.emacs.d/"))) + (t olddef))) + "The filename to save completions to." :type 'file :group 'completion) (defcustom save-completions-retention-time 336 - "*Discard a completion if unused for this many hours. + "Discard a completion if unused for this many hours. \(1 day = 24, 1 week = 168). If this is 0, non-permanent completions will not be saved unless these are used. Default is two weeks." :type 'integer :group 'completion) (defcustom completion-on-separator-character nil - "*Non-nil means separator characters mark previous word as used. + "Non-nil means separator characters mark previous word as used. This means the word will be saved as a completion." :type 'boolean :group 'completion) (defcustom completions-file-versions-kept kept-new-versions - "*Number of versions to keep for the saved completions file." + "Number of versions to keep for the saved completions file." :type 'integer :group 'completion) (defcustom completion-prompt-speed-threshold 4800 - "*Minimum output speed at which to display next potential completion." + "Minimum output speed at which to display next potential completion." :type 'integer :group 'completion) (defcustom completion-cdabbrev-prompt-flag nil - "*If non-nil, the next completion prompt does a cdabbrev search. + "If non-nil, the next completion prompt does a cdabbrev search. This can be time consuming." :type 'boolean :group 'completion) (defcustom completion-search-distance 15000 - "*How far to search in the buffer when looking for completions. + "How far to search in the buffer when looking for completions. In number of characters. If nil, search the whole buffer." :type 'integer :group 'completion) (defcustom completions-merging-modes '(lisp c) - "*List of modes {`c' or `lisp'} for automatic completions merging. + "List of modes {`c' or `lisp'} for automatic completions merging. Definitions from visited files which have these modes are automatically added to the completion database." :type '(set (const lisp) (const c)) @@ -495,7 +501,7 @@ Used to decide whether to save completions.") ;; Table definitions ;;----------------------------------------------- -(defun cmpl-make-standard-completion-syntax-table () +(defconst completion-standard-syntax-table (let ((table (make-syntax-table)) i) ;; Default syntax is whitespace. @@ -523,36 +529,9 @@ Used to decide whether to save completions.") (modify-syntax-entry char "w" table))) table)) -(defconst cmpl-standard-syntax-table (cmpl-make-standard-completion-syntax-table)) - -(defun cmpl-make-lisp-completion-syntax-table () - (let ((table (copy-syntax-table cmpl-standard-syntax-table)) - (symbol-chars '(?! ?& ?? ?= ?^))) - (dolist (char symbol-chars) - (modify-syntax-entry char "_" table)) - table)) - -(defun cmpl-make-c-completion-syntax-table () - (let ((table (copy-syntax-table cmpl-standard-syntax-table)) - (separator-chars '(?+ ?* ?/ ?: ?%))) - (dolist (char separator-chars) - (modify-syntax-entry char " " table)) - table)) - -(defun cmpl-make-fortran-completion-syntax-table () - (let ((table (copy-syntax-table cmpl-standard-syntax-table)) - (separator-chars '(?+ ?- ?* ?/ ?:))) - (dolist (char separator-chars) - (modify-syntax-entry char " " table)) - table)) - -(defconst cmpl-lisp-syntax-table (cmpl-make-lisp-completion-syntax-table)) -(defconst cmpl-c-syntax-table (cmpl-make-c-completion-syntax-table)) -(defconst cmpl-fortran-syntax-table (cmpl-make-fortran-completion-syntax-table)) - -(defvar cmpl-syntax-table cmpl-standard-syntax-table +(defvar completion-syntax-table completion-standard-syntax-table "This variable holds the current completion syntax table.") -(make-variable-buffer-local 'cmpl-syntax-table) +(make-variable-buffer-local 'completion-syntax-table) ;;----------------------------------------------- ;; Symbol functions @@ -561,43 +540,34 @@ Used to decide whether to save completions.") "Holds first character of symbol, after any completion symbol function.") (defvar cmpl-symbol-end nil "Holds last character of symbol, after any completion symbol function.") -;; These are temp. vars. we use to avoid using let. -;; Why ? Small speed improvement. -(defvar cmpl-saved-syntax nil) -(defvar cmpl-saved-point nil) (defun symbol-under-point () "Return the symbol that the point is currently on. But only if it is longer than `completion-min-length'." - (setq cmpl-saved-syntax (syntax-table)) - (unwind-protect - (progn - (set-syntax-table cmpl-syntax-table) - (cond - ;; Cursor is on following-char and after preceding-char - ((memq (char-syntax (following-char)) '(?w ?_)) - (setq cmpl-saved-point (point) - cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1) - cmpl-symbol-end (scan-sexps cmpl-saved-point 1)) - ;; Remove chars to ignore at the start. - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - (goto-char cmpl-saved-point))) - ;; Remove chars to ignore at the end. - (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w) - (goto-char cmpl-symbol-end) - (forward-word -1) - (setq cmpl-symbol-end (point)) - (goto-char cmpl-saved-point))) - ;; Return completion if the length is reasonable. - (if (and (<= completion-min-length - (- cmpl-symbol-end cmpl-symbol-start)) - (<= (- cmpl-symbol-end cmpl-symbol-start) - completion-max-length)) - (buffer-substring cmpl-symbol-start cmpl-symbol-end))))) - (set-syntax-table cmpl-saved-syntax))) + (with-syntax-table completion-syntax-table + (when (memq (char-syntax (following-char)) '(?w ?_)) + ;; Cursor is on following-char and after preceding-char + (let ((saved-point (point))) + (setq cmpl-symbol-start (scan-sexps (1+ saved-point) -1) + cmpl-symbol-end (scan-sexps saved-point 1)) + ;; Remove chars to ignore at the start. + (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) + (goto-char cmpl-symbol-start) + (forward-word 1) + (setq cmpl-symbol-start (point)) + (goto-char saved-point))) + ;; Remove chars to ignore at the end. + (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w) + (goto-char cmpl-symbol-end) + (forward-word -1) + (setq cmpl-symbol-end (point)) + (goto-char saved-point))) + ;; Return completion if the length is reasonable. + (if (and (<= completion-min-length + (- cmpl-symbol-end cmpl-symbol-start)) + (<= (- cmpl-symbol-end cmpl-symbol-start) + completion-max-length)) + (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))) ;; tests for symbol-under-point ;; `^' indicates cursor pos. where value is returned @@ -615,46 +585,42 @@ But only if it is longer than `completion-min-length'." "Return a string of the symbol immediately before point. Returns nil if there isn't one longer than `completion-min-length'." ;; This is called when a word separator is typed so it must be FAST ! - (setq cmpl-saved-syntax (syntax-table)) - (unwind-protect - (progn - (set-syntax-table cmpl-syntax-table) - ;; Cursor is on following-char and after preceding-char - (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_) - ;; Number of chars to ignore at end. - (setq cmpl-symbol-end (point) - cmpl-symbol-start (scan-sexps cmpl-symbol-end -1)) - ;; Remove chars to ignore at the start. - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - (goto-char cmpl-symbol-end))) - ;; Return value if long enough. - (if (>= cmpl-symbol-end - (+ cmpl-symbol-start completion-min-length)) - (buffer-substring cmpl-symbol-start cmpl-symbol-end))) - ((= cmpl-preceding-syntax ?w) - ;; chars to ignore at end - (setq cmpl-saved-point (point) - cmpl-symbol-start (scan-sexps cmpl-saved-point -1)) - ;; take off chars. from end - (forward-word -1) - (setq cmpl-symbol-end (point)) - ;; remove chars to ignore at the start - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)))) - ;; Restore state. - (goto-char cmpl-saved-point) - ;; Return completion if the length is reasonable - (if (and (<= completion-min-length - (- cmpl-symbol-end cmpl-symbol-start)) - (<= (- cmpl-symbol-end cmpl-symbol-start) - completion-max-length)) - (buffer-substring cmpl-symbol-start cmpl-symbol-end))))) - (set-syntax-table cmpl-saved-syntax))) + (with-syntax-table completion-syntax-table + ;; Cursor is on following-char and after preceding-char + (cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_) + ;; Number of chars to ignore at end. + (setq cmpl-symbol-end (point) + cmpl-symbol-start (scan-sexps cmpl-symbol-end -1)) + ;; Remove chars to ignore at the start. + (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) + (goto-char cmpl-symbol-start) + (forward-word 1) + (setq cmpl-symbol-start (point)) + (goto-char cmpl-symbol-end))) + ;; Return value if long enough. + (if (>= cmpl-symbol-end + (+ cmpl-symbol-start completion-min-length)) + (buffer-substring cmpl-symbol-start cmpl-symbol-end))) + ((= cmpl-preceding-syntax ?w) + ;; chars to ignore at end + (let ((saved-point (point))) + (setq cmpl-symbol-start (scan-sexps saved-point -1)) + ;; take off chars. from end + (forward-word -1) + (setq cmpl-symbol-end (point)) + ;; remove chars to ignore at the start + (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) + (goto-char cmpl-symbol-start) + (forward-word 1) + (setq cmpl-symbol-start (point)))) + ;; Restore state. + (goto-char saved-point) + ;; Return completion if the length is reasonable + (if (and (<= completion-min-length + (- cmpl-symbol-end cmpl-symbol-start)) + (<= (- cmpl-symbol-end cmpl-symbol-start) + completion-max-length)) + (buffer-substring cmpl-symbol-start cmpl-symbol-end))))))) ;; tests for symbol-before-point ;; `^' indicates cursor pos. where value is returned @@ -675,17 +641,11 @@ Returns nil if there isn't one longer than `completion-min-length'." ;; copying all the code. ;; However, it is only used by the completion string prompter. ;; If it comes into common use, it could be rewritten. - (cond ((memq (progn - (setq cmpl-saved-syntax (syntax-table)) - (unwind-protect - (progn - (set-syntax-table cmpl-syntax-table) - (char-syntax (following-char))) - (set-syntax-table cmpl-saved-syntax))) - '(?w ?_)) - (symbol-under-point)) - (t - (symbol-before-point)))) + (if (memq (with-syntax-table completion-syntax-table + (char-syntax (following-char))) + '(?w ?_)) + (symbol-under-point) + (symbol-before-point))) (defun symbol-before-point-for-complete () @@ -693,28 +653,23 @@ Returns nil if there isn't one longer than `completion-min-length'." ;; or nil if there isn't one. Like symbol-before-point but doesn't trim the ;; end chars." ;; Cursor is on following-char and after preceding-char - (setq cmpl-saved-syntax (syntax-table)) - (unwind-protect - (progn - (set-syntax-table cmpl-syntax-table) - (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char))) - '(?_ ?w)) - (setq cmpl-symbol-end (point) - cmpl-symbol-start (scan-sexps cmpl-symbol-end -1)) - ;; Remove chars to ignore at the start. - (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) - (goto-char cmpl-symbol-start) - (forward-word 1) - (setq cmpl-symbol-start (point)) - (goto-char cmpl-symbol-end))) - ;; Return completion if the length is reasonable. - (if (and (<= completion-prefix-min-length - (- cmpl-symbol-end cmpl-symbol-start)) - (<= (- cmpl-symbol-end cmpl-symbol-start) - completion-max-length)) - (buffer-substring cmpl-symbol-start cmpl-symbol-end))))) - ;; Restore syntax table. - (set-syntax-table cmpl-saved-syntax))) + (with-syntax-table completion-syntax-table + (cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char))) + '(?_ ?w)) + (setq cmpl-symbol-end (point) + cmpl-symbol-start (scan-sexps cmpl-symbol-end -1)) + ;; Remove chars to ignore at the start. + (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w) + (goto-char cmpl-symbol-start) + (forward-word 1) + (setq cmpl-symbol-start (point)) + (goto-char cmpl-symbol-end))) + ;; Return completion if the length is reasonable. + (if (and (<= completion-prefix-min-length + (- cmpl-symbol-end cmpl-symbol-start)) + (<= (- cmpl-symbol-end cmpl-symbol-start) + completion-max-length)) + (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))) ;; tests for symbol-before-point-for-complete ;; `^' indicates cursor pos. where value is returned @@ -866,7 +821,7 @@ This is sensitive to `case-fold-search'." (setq saved-point (point) saved-syntax (syntax-table)) ;; Restore completion state - (set-syntax-table cmpl-syntax-table) + (set-syntax-table completion-syntax-table) (goto-char cdabbrev-current-point) ;; Loop looking for completions (while @@ -1010,8 +965,8 @@ Each symbol is bound to a single completion entry.") ;; CONSTRUCTOR (defun make-completion (string) - "Return a list of a completion entry." - (list (list string 0 nil current-completion-source))) + "Return a completion entry." + (list string 0 nil current-completion-source)) ;; Obsolete ;;(defmacro cmpl-prefix-entry-symbol (completion-entry) @@ -1026,11 +981,9 @@ Each symbol is bound to a single completion entry.") ;; READER Macros -(defmacro cmpl-prefix-entry-head (prefix-entry) - (list 'car prefix-entry)) +(defalias 'cmpl-prefix-entry-head 'car) -(defmacro cmpl-prefix-entry-tail (prefix-entry) - (list 'cdr prefix-entry)) +(defalias 'cmpl-prefix-entry-tail 'cdr) ;; WRITER Macros @@ -1092,17 +1045,17 @@ Each symbol is bound to a single completion entry.") ;; These are the internal functions used to update the datebase ;; ;; -(defvar completion-to-accept nil) - ;;"Set to a string that is pending its acceptance." +(defvar completion-to-accept nil + "Set to a string that is pending its acceptance.") ;; this checked by the top level reading functions -(defvar cmpl-db-downcase-string nil) - ;; "Setup by find-exact-completion, etc. The given string, downcased." -(defvar cmpl-db-symbol nil) - ;; "The interned symbol corresponding to cmpl-db-downcase-string. - ;; Set up by cmpl-db-symbol." -(defvar cmpl-db-prefix-symbol nil) - ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string." +(defvar cmpl-db-downcase-string nil + "Setup by `find-exact-completion', etc. The given string, downcased.") +(defvar cmpl-db-symbol nil + "The interned symbol corresponding to `cmpl-db-downcase-string'. +Set up by `cmpl-db-symbol'.") +(defvar cmpl-db-prefix-symbol nil + "The interned prefix symbol corresponding to `cmpl-db-downcase-string'.") (defvar cmpl-db-entry nil) (defvar cmpl-db-debug-p nil "Set to t if you want to debug the database.") @@ -1190,7 +1143,7 @@ Returns the completion entry." (or (find-exact-completion string) ;; not there (let (;; create an entry - (entry (make-completion string)) + (entry (list (make-completion string))) ;; setup the prefix (prefix-entry (find-cmpl-prefix-entry (substring cmpl-db-downcase-string 0 @@ -1244,7 +1197,7 @@ Returns the completion entry." cmpl-db-entry) ;; not there (let (;; create an entry - (entry (make-completion completion-string)) + (entry (list (make-completion completion-string))) ;; setup the prefix (prefix-entry (find-cmpl-prefix-entry (substring cmpl-db-downcase-string 0 @@ -1650,7 +1603,7 @@ Prefix args :: (setq cmpl-current-index (+ cmpl-current-index (or arg 1)))) (t (if (not cmpl-initialized-p) - (initialize-completions)) ;; make sure everything's loaded + (completion-initialize)) ;; make sure everything's loaded (cond ((consp current-prefix-arg) ;; control-u (setq arg 0) (setq cmpl-leave-point-at-start t)) @@ -1752,9 +1705,8 @@ Prefix args :: (let ((completions-merging-modes nil)) (setq buffer (find-file-noselect file)))) (unwind-protect - (save-excursion - (set-buffer buffer) - (add-completions-from-buffer)) + (with-current-buffer buffer + (add-completions-from-buffer)) (if (not buffer-already-there-p) (kill-buffer buffer))))) @@ -1781,7 +1733,7 @@ Prefix args :: start-num))))) ;; Find file hook -(defun cmpl-find-file-hook () +(defun completion-find-file-hook () (cond (enable-completion (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode)) (memq 'lisp completions-merging-modes)) @@ -1864,7 +1816,7 @@ Prefix args :: ;; Whitespace chars (have symbol syntax) ;; Everything else has word syntax -(defun cmpl-make-c-def-completion-syntax-table () +(defconst completion-c-def-syntax-table (let ((table (make-syntax-table)) (whitespace-chars '(? ?\n ?\t ?\f ?\v ?\r)) ;; unfortunately the ?( causes the parens to appear unbalanced @@ -1885,8 +1837,6 @@ Prefix args :: (modify-syntax-entry ?\} "){" table) table)) -(defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table)) - ;; Regexps (defconst *c-def-regexp* ;; This stops on lines with possible definitions @@ -1930,81 +1880,77 @@ Prefix args :: ;; Benchmark -- ;; Sun 3/280-- 1250 lines/sec. - (let (string next-point char - (saved-syntax (syntax-table))) + (let (string next-point char) (save-excursion (goto-char (point-min)) (catch 'finish-add-completions - (unwind-protect - (while t - ;; we loop here only when scan-sexps fails - ;; (i.e. unbalance exps.) - (set-syntax-table cmpl-c-def-syntax-table) - (condition-case e - (while t - (re-search-forward *c-def-regexp*) - (cond - ((= (preceding-char) ?#) - ;; preprocessor macro, see if it's one we handle - (setq string (buffer-substring (point) (+ (point) 6))) - (cond ((or (string-equal string "define") - (string-equal string "ifdef ")) - ;; skip forward over definition symbol - ;; and add it to database - (and (forward-word 2) - (setq string (symbol-before-point)) - ;;(push string foo) - (add-completion-to-tail-if-new string))))) - (t - ;; C definition - (setq next-point (point)) - (while (and - next-point - ;; scan to next separator char. - (setq next-point (scan-sexps next-point 1))) - ;; position the point on the word we want to add - (goto-char next-point) - (while (= (setq char (following-char)) ?*) - ;; handle pointer ref - ;; move to next separator char. - (goto-char - (setq next-point (scan-sexps (point) 1)))) - (forward-word -1) - ;; add to database - (if (setq string (symbol-under-point)) - ;; (push string foo) - (add-completion-to-tail-if-new string) - ;; Local TMC hack (useful for parsing paris.h) - (if (and (looking-at "_AP") ;; "ansi prototype" - (progn - (forward-word -1) - (setq string - (symbol-under-point)))) - (add-completion-to-tail-if-new string))) - ;; go to next - (goto-char next-point) - ;; (push (format "%c" (following-char)) foo) - (if (= (char-syntax char) ?\() - ;; if on an opening delimiter, go to end - (while (= (char-syntax char) ?\() - (setq next-point (scan-sexps next-point 1) - char (char-after next-point))) - (or (= char ?,) - ;; Current char is an end char. - (setq next-point nil))))))) - (search-failed ;;done - (throw 'finish-add-completions t)) - (error - ;; Check for failure in scan-sexps - (if (or (string-equal (nth 1 e) - "Containing expression ends prematurely") - (string-equal (nth 1 e) "Unbalanced parentheses")) - ;; unbalanced paren., keep going - ;;(ding) - (forward-line 1) - (message "Error parsing C buffer for completions--please send bug report") - (throw 'finish-add-completions t))))) - (set-syntax-table saved-syntax)))))) + (with-syntax-table completion-c-def-syntax-table + (while t + ;; we loop here only when scan-sexps fails + ;; (i.e. unbalance exps.) + (condition-case e + (while t + (re-search-forward *c-def-regexp*) + (cond + ((= (preceding-char) ?#) + ;; preprocessor macro, see if it's one we handle + (setq string (buffer-substring (point) (+ (point) 6))) + (cond ((member string '("define" "ifdef ")) + ;; skip forward over definition symbol + ;; and add it to database + (and (forward-word 2) + (setq string (symbol-before-point)) + ;;(push string foo) + (add-completion-to-tail-if-new string))))) + (t + ;; C definition + (setq next-point (point)) + (while (and + next-point + ;; scan to next separator char. + (setq next-point (scan-sexps next-point 1))) + ;; position the point on the word we want to add + (goto-char next-point) + (while (= (setq char (following-char)) ?*) + ;; handle pointer ref + ;; move to next separator char. + (goto-char + (setq next-point (scan-sexps (point) 1)))) + (forward-word -1) + ;; add to database + (if (setq string (symbol-under-point)) + ;; (push string foo) + (add-completion-to-tail-if-new string) + ;; Local TMC hack (useful for parsing paris.h) + (if (and (looking-at "_AP") ;; "ansi prototype" + (progn + (forward-word -1) + (setq string + (symbol-under-point)))) + (add-completion-to-tail-if-new string))) + ;; go to next + (goto-char next-point) + ;; (push (format "%c" (following-char)) foo) + (if (= (char-syntax char) ?\() + ;; if on an opening delimiter, go to end + (while (= (char-syntax char) ?\() + (setq next-point (scan-sexps next-point 1) + char (char-after next-point))) + (or (= char ?,) + ;; Current char is an end char. + (setq next-point nil))))))) + (search-failed ;;done + (throw 'finish-add-completions t)) + (error + ;; Check for failure in scan-sexps + (if (or (string-equal (nth 1 e) + "Containing expression ends prematurely") + (string-equal (nth 1 e) "Unbalanced parentheses")) + ;; unbalanced paren., keep going + ;;(ding) + (forward-line 1) + (message "Error parsing C buffer for completions--please send bug report") + (throw 'finish-add-completions t)))))))))) ;;--------------------------------------------------------------------------- @@ -2018,7 +1964,8 @@ Prefix args :: ((not cmpl-completions-accepted-p) (message "Completions database has not changed - not writing.")) (t - (save-completions-to-file))))) + (save-completions-to-file)))) + (cmpl-statistics-block (record-cmpl-kill-emacs))) ;; There is no point bothering to change this again ;; unless the package changes so much that it matters @@ -2046,7 +1993,7 @@ If file name is not specified, use `save-completions-file-name'." (if (file-writable-p filename) (progn (if (not cmpl-initialized-p) - (initialize-completions));; make sure everything's loaded + (completion-initialize)) ;; make sure everything's loaded (message "Saving completions to file %s" filename) (let* ((delete-old-versions t) @@ -2059,9 +2006,7 @@ If file name is not specified, use `save-completions-file-name'." (total-saved 0) (backup-filename (completion-backup-filename filename))) - (save-excursion - (get-buffer-create " *completion-save-buffer*") - (set-buffer " *completion-save-buffer*") + (with-current-buffer (get-buffer-create " *completion-save-buffer*") (setq buffer-file-name filename) (if (not (verify-visited-file-modtime (current-buffer))) @@ -2151,9 +2096,7 @@ If file is not specified, then use `save-completions-file-name'." (if (not no-message-p) (message "Loading completions from %sfile %s . . ." (if backup-readable-p "backup " "") filename)) - (save-excursion - (get-buffer-create " *completion-save-buffer*") - (set-buffer " *completion-save-buffer*") + (with-current-buffer (get-buffer-create " *completion-save-buffer*") (setq buffer-file-name filename) ;; prepare the buffer to be modified (clear-visited-file-modtime) @@ -2161,8 +2104,7 @@ If file is not specified, then use `save-completions-file-name'." (let ((insert-okay-p nil) (buffer (current-buffer)) - (current-time (cmpl-hours-since-origin)) - string num-uses entry last-use-time + string entry last-use-time cmpl-entry cmpl-last-use-time (current-completion-source cmpl-source-init-file) (start-num @@ -2233,13 +2175,13 @@ If file is not specified, then use `save-completions-file-name'." start-num))) )))))) -(defun initialize-completions () +(defun completion-initialize () "Load the default completions file. Also sets up so that exiting Emacs will automatically save the file." (interactive) - (cond ((not cmpl-initialized-p) - (load-completions-from-file))) - (setq cmpl-initialized-p t)) + (unless cmpl-initialized-p + (load-completions-from-file) + (setq cmpl-initialized-p t))) ;;----------------------------------------------- ;; Kill region patch @@ -2302,33 +2244,21 @@ Patched to remove the most recent completion." ;; Note that because of the way byte compiling works, none of ;; the functions defined with this macro get byte compiled. -(defmacro def-completion-wrapper (function-name type &optional new-name) +(defun completion-def-wrapper (function-name type) "Add a call to update the completion database before function execution. TYPE is the type of the wrapper to be added. Can be :before or :under." - (cond ((eq type :separator) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-before-separator)) - ((eq type :before) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-before-point)) - ((eq type :backward-under) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-backward-under)) - ((eq type :backward) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-backward)) - ((eq type :under) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-under-point)) - ((eq type :under-or-before) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-under-or-before-point)) - ((eq type :minibuffer-separator) - (list 'put (list 'quote function-name) ''completion-function - ''use-completion-minibuffer-separator)))) + (put function-name 'completion-function + (cdr (assq type + '((:separator 'use-completion-before-separator) + (:before 'use-completion-before-point) + (:backward-under 'use-completion-backward-under) + (:backward 'use-completion-backward) + (:under 'use-completion-under-point) + (:under-or-before 'use-completion-under-or-before-point) + (:minibuffer-separator 'use-completion-minibuffer-separator)))))) (defun use-completion-minibuffer-separator () - (let ((cmpl-syntax-table cmpl-standard-syntax-table)) + (let ((completion-syntax-table completion-standard-syntax-table)) (use-completion-before-separator))) (defun use-completion-backward-under () @@ -2347,170 +2277,197 @@ TYPE is the type of the wrapper to be added. Can be :before or :under." (get this-command 'completion-function)) 'use-completion-under-or-before-point))) +;; Lisp mode diffs. + +(defconst completion-lisp-syntax-table + (let ((table (copy-syntax-table completion-standard-syntax-table)) + (symbol-chars '(?! ?& ?? ?= ?^))) + (dolist (char symbol-chars) + (modify-syntax-entry char "_" table)) + table)) + +(defun completion-lisp-mode-hook () + (setq completion-syntax-table completion-lisp-syntax-table) + ;; Lisp Mode diffs + (local-set-key "!" 'self-insert-command) + (local-set-key "&" 'self-insert-command) + (local-set-key "%" 'self-insert-command) + (local-set-key "?" 'self-insert-command) + (local-set-key "=" 'self-insert-command) + (local-set-key "^" 'self-insert-command)) + ;; C mode diffs. -(defvar c-mode-map) +(defconst completion-c-syntax-table + (let ((table (copy-syntax-table completion-standard-syntax-table)) + (separator-chars '(?+ ?* ?/ ?: ?%))) + (dolist (char separator-chars) + (modify-syntax-entry char " " table)) + table)) +(completion-def-wrapper 'electric-c-semi :separator) (defun completion-c-mode-hook () - (def-completion-wrapper electric-c-semi :separator) - (define-key c-mode-map "+" 'completion-separator-self-insert-command) - (define-key c-mode-map "*" 'completion-separator-self-insert-command) - (define-key c-mode-map "/" 'completion-separator-self-insert-command)) -;; Do this either now or whenever C mode is loaded. -(if (featurep 'cc-mode) - (completion-c-mode-hook) - (add-hook 'c-mode-hook 'completion-c-mode-hook)) + (setq completion-syntax-table completion-c-syntax-table) + (local-set-key "+" 'completion-separator-self-insert-command) + (local-set-key "*" 'completion-separator-self-insert-command) + (local-set-key "/" 'completion-separator-self-insert-command)) ;; FORTRAN mode diffs. (these are defined when fortran is called) -(defvar fortran-mode-map) +(defconst completion-fortran-syntax-table + (let ((table (copy-syntax-table completion-standard-syntax-table)) + (separator-chars '(?+ ?- ?* ?/ ?:))) + (dolist (char separator-chars) + (modify-syntax-entry char " " table)) + table)) (defun completion-setup-fortran-mode () - (define-key fortran-mode-map "+" 'completion-separator-self-insert-command) - (define-key fortran-mode-map "-" 'completion-separator-self-insert-command) - (define-key fortran-mode-map "*" 'completion-separator-self-insert-command) - (define-key fortran-mode-map "/" 'completion-separator-self-insert-command)) + (setq completion-syntax-table completion-fortran-syntax-table) + (local-set-key "+" 'completion-separator-self-insert-command) + (local-set-key "-" 'completion-separator-self-insert-command) + (local-set-key "*" 'completion-separator-self-insert-command) + (local-set-key "/" 'completion-separator-self-insert-command)) -;;; Enable completion mode. +;; Enable completion mode. + +(defvar fortran-mode-hook) + +(defvar completion-saved-bindings nil) ;;;###autoload -(defun dynamic-completion-mode () +(define-minor-mode dynamic-completion-mode "Enable dynamic word-completion." - (interactive) - (add-hook 'find-file-hook 'cmpl-find-file-hook) - (add-hook 'pre-command-hook 'completion-before-command) - - ;; Install the appropriate mode tables. - (add-hook 'lisp-mode-hook - (lambda () - (setq cmpl-syntax-table cmpl-lisp-syntax-table))) - (add-hook 'c-mode-hook - (lambda () - (setq cmpl-syntax-table cmpl-c-syntax-table))) - (add-hook 'fortran-mode-hook - (lambda () - (setq cmpl-syntax-table cmpl-fortran-syntax-table) - (completion-setup-fortran-mode))) - - ;; "Complete" Key Keybindings. - - (global-set-key "\M-\r" 'complete) - (global-set-key [?\C-\r] 'complete) + :global t + ;; This is always good, not specific to dynamic-completion-mode. (define-key function-key-map [C-return] [?\C-\r]) - ;; Tests - - ;; (add-completion "cumberland") - ;; (add-completion "cumberbund") - ;; cum - ;; Cumber - ;; cumbering - ;; cumb - - ;; Save completions when killing Emacs. - - (add-hook 'kill-emacs-hook - (lambda () - (kill-emacs-save-completions) - (cmpl-statistics-block - (record-cmpl-kill-emacs)))) - - ;; Patches to standard keymaps insert completions - (substitute-key-definition 'kill-region 'completion-kill-region - global-map) - - ;; Separators - ;; We've used the completion syntax table given as a guide. - ;; - ;; Global separator chars. - ;; We left out <tab> because there are too many special cases for it. Also, - ;; in normal coding it's rarely typed after a word. - (global-set-key " " 'completion-separator-self-insert-autofilling) - (global-set-key "!" 'completion-separator-self-insert-command) - (global-set-key "%" 'completion-separator-self-insert-command) - (global-set-key "^" 'completion-separator-self-insert-command) - (global-set-key "&" 'completion-separator-self-insert-command) - (global-set-key "(" 'completion-separator-self-insert-command) - (global-set-key ")" 'completion-separator-self-insert-command) - (global-set-key "=" 'completion-separator-self-insert-command) - (global-set-key "`" 'completion-separator-self-insert-command) - (global-set-key "|" 'completion-separator-self-insert-command) - (global-set-key "{" 'completion-separator-self-insert-command) - (global-set-key "}" 'completion-separator-self-insert-command) - (global-set-key "[" 'completion-separator-self-insert-command) - (global-set-key "]" 'completion-separator-self-insert-command) - (global-set-key ";" 'completion-separator-self-insert-command) - (global-set-key "\"" 'completion-separator-self-insert-command) - (global-set-key "'" 'completion-separator-self-insert-command) - (global-set-key "#" 'completion-separator-self-insert-command) - (global-set-key "," 'completion-separator-self-insert-command) - (global-set-key "?" 'completion-separator-self-insert-command) - - ;; We include period and colon even though they are symbol chars because : - ;; - in text we want to pick up the last word in a sentence. - ;; - in C pointer refs. we want to pick up the first symbol - ;; - it won't make a difference for lisp mode (package names are short) - (global-set-key "." 'completion-separator-self-insert-command) - (global-set-key ":" 'completion-separator-self-insert-command) + (dolist (x '((find-file-hook . completion-find-file-hook) + (pre-command-hook . completion-before-command) + ;; Save completions when killing Emacs. + (kill-emacs-hook . kill-emacs-save-completions) + + ;; Install the appropriate mode tables. + (lisp-mode-hook . completion-lisp-mode-hook) + (c-mode-hook . completion-c-mode-hook) + (fortran-mode-hook . completion-setup-fortran-mode))) + (if dynamic-completion-mode + (add-hook (car x) (cdr x)) + (remove-hook (car x) (cdr x)))) + + ;; "Complete" Key Keybindings. We don't want to use a minor-mode + ;; map because these have too high a priority. We could/should + ;; probably change the interpretation of minor-mode-map-alist such + ;; that a map has lower precedence if the symbol is not buffer-local. + (while completion-saved-bindings + (let ((binding (pop completion-saved-bindings))) + (global-set-key (car binding) (cdr binding)))) + (when dynamic-completion-mode + (dolist (binding + '(("\M-\r" . complete) + ([?\C-\r] . complete) + + ;; Tests - + ;; (add-completion "cumberland") + ;; (add-completion "cumberbund") + ;; cum + ;; Cumber + ;; cumbering + ;; cumb + + ;; Patches to standard keymaps insert completions + ([remap kill-region] . completion-kill-region) + + ;; Separators + ;; We've used the completion syntax table given as a guide. + ;; + ;; Global separator chars. + ;; We left out <tab> because there are too many special + ;; cases for it. Also, in normal coding it's rarely typed + ;; after a word. + (" " . completion-separator-self-insert-autofilling) + ("!" . completion-separator-self-insert-command) + ("%" . completion-separator-self-insert-command) + ("^" . completion-separator-self-insert-command) + ("&" . completion-separator-self-insert-command) + ("(" . completion-separator-self-insert-command) + (")" . completion-separator-self-insert-command) + ("=" . completion-separator-self-insert-command) + ("`" . completion-separator-self-insert-command) + ("|" . completion-separator-self-insert-command) + ("{" . completion-separator-self-insert-command) + ("}" . completion-separator-self-insert-command) + ("[" . completion-separator-self-insert-command) + ("]" . completion-separator-self-insert-command) + (";" . completion-separator-self-insert-command) + ("\"". completion-separator-self-insert-command) + ("'" . completion-separator-self-insert-command) + ("#" . completion-separator-self-insert-command) + ("," . completion-separator-self-insert-command) + ("?" . completion-separator-self-insert-command) + + ;; We include period and colon even though they are symbol + ;; chars because : + ;; - in text we want to pick up the last word in a sentence. + ;; - in C pointer refs. we want to pick up the first symbol + ;; - it won't make a difference for lisp mode (package names + ;; are short) + ("." . completion-separator-self-insert-command) + (":" . completion-separator-self-insert-command))) + (push (cons (car binding) (lookup-key global-map (car binding))) + completion-saved-bindings) + (global-set-key (car binding) (cdr binding))) + + ;; Tests -- + ;; foobarbiz + ;; foobar + ;; fooquux + ;; fooper - ;; Lisp Mode diffs - (define-key lisp-mode-map "!" 'self-insert-command) - (define-key lisp-mode-map "&" 'self-insert-command) - (define-key lisp-mode-map "%" 'self-insert-command) - (define-key lisp-mode-map "?" 'self-insert-command) - (define-key lisp-mode-map "=" 'self-insert-command) - (define-key lisp-mode-map "^" 'self-insert-command) - - ;; Avoid warnings. - (defvar c-mode-map) - (defvar fortran-mode-map) - - ;;----------------------------------------------- - ;; End of line chars. - ;;----------------------------------------------- - (def-completion-wrapper newline :separator) - (def-completion-wrapper newline-and-indent :separator) - (def-completion-wrapper comint-send-input :separator) - (def-completion-wrapper exit-minibuffer :minibuffer-separator) - (def-completion-wrapper eval-print-last-sexp :separator) - (def-completion-wrapper eval-last-sexp :separator) - ;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer) - - ;;----------------------------------------------- - ;; Cursor movement - ;;----------------------------------------------- - - (def-completion-wrapper next-line :under-or-before) - (def-completion-wrapper previous-line :under-or-before) - (def-completion-wrapper beginning-of-buffer :under-or-before) - (def-completion-wrapper end-of-buffer :under-or-before) - (def-completion-wrapper beginning-of-line :under-or-before) - (def-completion-wrapper end-of-line :under-or-before) - (def-completion-wrapper forward-char :under-or-before) - (def-completion-wrapper forward-word :under-or-before) - (def-completion-wrapper forward-sexp :under-or-before) - (def-completion-wrapper backward-char :backward-under) - (def-completion-wrapper backward-word :backward-under) - (def-completion-wrapper backward-sexp :backward-under) - - (def-completion-wrapper delete-backward-char :backward) - (def-completion-wrapper delete-backward-char-untabify :backward) - - ;; Tests -- - ;; foobarbiz - ;; foobar - ;; fooquux - ;; fooper + (cmpl-statistics-block + (record-completion-file-loaded)) - (cmpl-statistics-block - (record-completion-file-loaded)) + (completion-initialize))) + +;;----------------------------------------------- +;; End of line chars. +;;----------------------------------------------- +(completion-def-wrapper 'newline :separator) +(completion-def-wrapper 'newline-and-indent :separator) +(completion-def-wrapper 'comint-send-input :separator) +(completion-def-wrapper 'exit-minibuffer :minibuffer-separator) +(completion-def-wrapper 'eval-print-last-sexp :separator) +(completion-def-wrapper 'eval-last-sexp :separator) +;;(completion-def-wrapper 'minibuffer-complete-and-exit :minibuffer) - (initialize-completions)) +;;----------------------------------------------- +;; Cursor movement +;;----------------------------------------------- -(mapc (lambda (x) (add-to-list 'debug-ignored-errors x)) - '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$" +(completion-def-wrapper 'next-line :under-or-before) +(completion-def-wrapper 'previous-line :under-or-before) +(completion-def-wrapper 'beginning-of-buffer :under-or-before) +(completion-def-wrapper 'end-of-buffer :under-or-before) +(completion-def-wrapper 'beginning-of-line :under-or-before) +(completion-def-wrapper 'end-of-line :under-or-before) +(completion-def-wrapper 'forward-char :under-or-before) +(completion-def-wrapper 'forward-word :under-or-before) +(completion-def-wrapper 'forward-sexp :under-or-before) +(completion-def-wrapper 'backward-char :backward-under) +(completion-def-wrapper 'backward-word :backward-under) +(completion-def-wrapper 'backward-sexp :backward-under) + +(completion-def-wrapper 'delete-backward-char :backward) +(completion-def-wrapper 'delete-backward-char-untabify :backward) + +;; Old names, non-namespace-clean. +(defvaralias 'cmpl-syntax-table 'completion-syntax-table) +(defalias 'initialize-completions 'completion-initialize) + +(dolist (x '("^To complete, the point must be after a symbol at least [0-9]* character long\\.$" "^The string \".*\" is too short to be saved as a completion\\.$")) + (add-to-list 'debug-ignored-errors x)) (provide 'completion) -;;; arch-tag: 6990dafe-4abd-4a1f-8c42-ffb25e120f5e +;; arch-tag: 6990dafe-4abd-4a1f-8c42-ffb25e120f5e ;;; completion.el ends here diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 59a8b341cad..b84568b7060 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -800,13 +800,18 @@ This operation eliminates any saved settings for the group members, making them as if they had never been customized at all." (interactive) (let ((children custom-options)) - (mapc (lambda (widget) - (and (widget-get widget :custom-standard-value) - (widget-apply widget :custom-standard-value) - (if (memq (widget-get widget :custom-state) - '(modified set changed saved rogue)) - (widget-apply widget :custom-reset-standard)))) - children))) + (when (or (and (= 1 (length children)) + (memq (widget-type (car children)) + '(custom-variable custom-face))) + (yes-or-no-p "Really erase all customizations in this buffer? ")) + (mapc (lambda (widget) + (and (if (widget-get widget :custom-standard-value) + (widget-apply widget :custom-standard-value) + t) + (memq (widget-get widget :custom-state) + '(modified set changed saved rogue)) + (widget-apply widget :custom-reset-standard))) + children)))) ;;; The Customize Commands diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 449efa5fe66..3e4e32ecc97 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -323,13 +323,18 @@ FACE's list property `theme-face' \(using `custom-push-theme')." (let ((face (nth 0 entry)) (spec (nth 1 entry)) (now (nth 2 entry)) - (comment (nth 3 entry))) + (comment (nth 3 entry)) + oldspec) ;; If FACE is actually an alias, customize the face it ;; is aliased to. (if (get face 'face-alias) (setq face (get face 'face-alias))) - (put face 'saved-face spec) - (put face 'saved-face-comment comment) + + (setq oldspec (get face 'theme-face)) + (when (not (and oldspec (eq 'user (caar oldspec)))) + (put face 'saved-face spec) + (put face 'saved-face-comment comment)) + (custom-push-theme 'theme-face face theme 'set spec) (when (or now immediate) (put face 'force-face (if now 'rogue 'immediate))) diff --git a/lisp/custom.el b/lisp/custom.el index 0c6085c714f..b2a9ba6443c 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1120,9 +1120,14 @@ See `custom-theme-load-themes' for more information on BODY." (defun enable-theme (theme) "Reenable all variable and face settings defined by THEME. The newly enabled theme gets the highest precedence (after `user'). -If it is already enabled, just give it highest precedence (after `user')." +If it is already enabled, just give it highest precedence (after `user'). + +This signals an error if THEME does not specify any theme +settings. Theme settings are set using `load-theme'." (interactive "SEnable Custom theme: ") (let ((settings (get theme 'theme-settings))) + (if (and (not (eq theme 'user)) (null settings)) + (error "No theme settings defined in %s." (symbol-name theme))) (dolist (s settings) (let* ((prop (car s)) (symbol (cadr s)) @@ -1130,7 +1135,8 @@ If it is already enabled, just give it highest precedence (after `user')." (put symbol prop (cons (cddr s) (assq-delete-all theme spec-list))) (if (eq prop 'theme-value) (custom-theme-recalc-variable symbol) - (custom-theme-recalc-face symbol))))) + (if (facep symbol) + (custom-theme-recalc-face symbol)))))) (setq custom-enabled-themes (cons theme (delq theme custom-enabled-themes))) ;; `user' must always be the highest-precedence enabled theme. diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el index b330f2b10d7..ea99030d943 100644 --- a/lisp/dabbrev.el +++ b/lisp/dabbrev.el @@ -373,11 +373,7 @@ function pointed out by `dabbrev-friend-buffer-function' to find the completions. If the prefix argument is 16 (which comes from C-u C-u), -then it searches *all* buffers. - -With no prefix argument, it reuses an old completion list -if there is a suitable one already." - +then it searches *all* buffers." (interactive "*P") (dabbrev--reset-global-variables) (let* ((dabbrev-check-other-buffers (and arg t)) @@ -392,57 +388,43 @@ if there is a suitable one already." (my-obarray dabbrev--last-obarray) init) (save-excursion - (if (and (null arg) - my-obarray - (or (eq dabbrev--last-completion-buffer (current-buffer)) - (and (window-minibuffer-p (selected-window)) - (eq dabbrev--last-completion-buffer - (dabbrev--minibuffer-origin)))) - dabbrev--last-abbreviation - (>= (length abbrev) (length dabbrev--last-abbreviation)) - (string= dabbrev--last-abbreviation - (substring abbrev 0 - (length dabbrev--last-abbreviation))) - (setq init (try-completion abbrev my-obarray))) - ;; We can reuse the existing completion list. - nil - ;;-------------------------------- - ;; New abbreviation to expand. - ;;-------------------------------- - (setq dabbrev--last-abbreviation abbrev) - ;; Find all expansion - (let ((completion-list - (dabbrev--find-all-expansions abbrev ignore-case-p)) - (completion-ignore-case ignore-case-p)) - ;; Make an obarray with all expansions - (setq my-obarray (make-vector (length completion-list) 0)) - (or (> (length my-obarray) 0) - (error "No dynamic expansion for \"%s\" found%s" - abbrev - (if dabbrev--check-other-buffers "" " in this-buffer"))) - (cond - ((or (not ignore-case-p) - (not dabbrev-case-replace)) - (mapc (function (lambda (string) - (intern string my-obarray))) - completion-list)) - ((string= abbrev (upcase abbrev)) - (mapc (function (lambda (string) - (intern (upcase string) my-obarray))) - completion-list)) - ((string= (substring abbrev 0 1) - (upcase (substring abbrev 0 1))) - (mapc (function (lambda (string) - (intern (capitalize string) my-obarray))) - completion-list)) - (t - (mapc (function (lambda (string) - (intern (downcase string) my-obarray))) - completion-list))) - (setq dabbrev--last-obarray my-obarray) - (setq dabbrev--last-completion-buffer (current-buffer)) - ;; Find the longest common string. - (setq init (try-completion abbrev my-obarray))))) + ;;-------------------------------- + ;; New abbreviation to expand. + ;;-------------------------------- + (setq dabbrev--last-abbreviation abbrev) + ;; Find all expansion + (let ((completion-list + (dabbrev--find-all-expansions abbrev ignore-case-p)) + (completion-ignore-case ignore-case-p)) + ;; Make an obarray with all expansions + (setq my-obarray (make-vector (length completion-list) 0)) + (or (> (length my-obarray) 0) + (error "No dynamic expansion for \"%s\" found%s" + abbrev + (if dabbrev--check-other-buffers "" " in this-buffer"))) + (cond + ((or (not ignore-case-p) + (not dabbrev-case-replace)) + (mapc (function (lambda (string) + (intern string my-obarray))) + completion-list)) + ((string= abbrev (upcase abbrev)) + (mapc (function (lambda (string) + (intern (upcase string) my-obarray))) + completion-list)) + ((string= (substring abbrev 0 1) + (upcase (substring abbrev 0 1))) + (mapc (function (lambda (string) + (intern (capitalize string) my-obarray))) + completion-list)) + (t + (mapc (function (lambda (string) + (intern (downcase string) my-obarray))) + completion-list))) + (setq dabbrev--last-obarray my-obarray) + (setq dabbrev--last-completion-buffer (current-buffer)) + ;; Find the longest common string. + (setq init (try-completion abbrev my-obarray)))) ;;-------------------------------- ;; Let the user choose between the expansions ;;-------------------------------- diff --git a/lisp/dframe.el b/lisp/dframe.el index 4be0ee8f097..56bbdc36c01 100644 --- a/lisp/dframe.el +++ b/lisp/dframe.el @@ -1,6 +1,6 @@ ;;; dframe --- dedicate frame support modes -;;; Copyright (C) 1996, 97, 98, 99, 2000, 01, 02, 03, 04 Free Software Foundation +;;; Copyright (C) 1996, 97, 98, 99, 2000, 01, 02, 03, 04, 05 Free Software Foundation ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: file, tags, tools @@ -509,7 +509,7 @@ a cons cell indicationg a position of the form (LEFT . TOP)." (setq newleft (+ pfx pfw 5) newtop pfy)) ((eq location 'left) - (setq newleft (+ pfx 10 nfw) + (setq newleft (- pfx 10 nfw) newtop pfy)) ((eq location 'left-right) (setq newleft diff --git a/lisp/ediff-wind.el b/lisp/ediff-wind.el index e15c92d4bc9..9fd9f45ff03 100644 --- a/lisp/ediff-wind.el +++ b/lisp/ediff-wind.el @@ -955,8 +955,9 @@ into icons, regardless of the window manager." (minibuffer-window designated-minibuffer-frame)) (cons 'width fwidth) - (cons 'height fheight)) - ) + (cons 'height fheight) + (cons 'user-position t) + )) ;; adjust autoraise (setq adjusted-parameters @@ -1135,9 +1136,8 @@ It assumes that it is called from within the control buffer." (list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params))))) (cons 'width (cdr (assoc 'width frame-A-params)))) ediff-wide-display-frame frame-A) - (modify-frame-parameters frame-A (list (cons 'left cw) - (cons 'width wd))))) - + (modify-frame-parameters + frame-A `((left . ,cw) (width . ,wd) (user-position t))))) ;; Revise the mode line to display which difference we have selected diff --git a/lisp/ediff.el b/lisp/ediff.el index 696fc9668e6..32ca177388e 100644 --- a/lisp/ediff.el +++ b/lisp/ediff.el @@ -8,7 +8,7 @@ ;; Keywords: comparing, merging, patching, tools, unix (defconst ediff-version "2.80.1" "The current version of Ediff") -(defconst ediff-date "October 5, 2005" "Date of last update") +(defconst ediff-date "November 25, 2005" "Date of last update") ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index ff795e6de77..2356483b233 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -135,6 +135,15 @@ or macro definition or a defcustom)." (if (equal setter ''custom-set-minor-mode) `(put ',varname 'custom-set 'custom-set-minor-mode)))))) + ((eq car 'defgroup) + ;; In Emacs this is normally handled separately by cus-dep.el, but for + ;; third party packages, it can be convenient to explicitly autoload + ;; a group. + (let ((groupname (nth 1 form))) + `(let ((loads (get ',groupname 'custom-loads))) + (if (member ',file loads) nil + (put ',groupname 'custom-loads (cons ',file loads)))))) + ;; nil here indicates that this is not a special autoload form. (t nil)))) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 74c77128059..244029491de 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2175,7 +2175,12 @@ copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors. (symbol-name (car args)) "")))) ((eq opt :constructor) (if (cdr args) - (push args constrs) + (progn + ;; If this defines a constructor of the same name as + ;; the default one, don't define the default. + (if (eq (car args) constructor) + (setq constructor nil)) + (push args constrs)) (if args (setq constructor (car args))))) ((eq opt :copier) (if args (setq copier (car args)))) diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 426c79e51c3..569847a0ea1 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -206,18 +206,28 @@ This variable is set by the master function.") "Master function symbol.") (defvar elp-not-profilable - '(elp-wrapper elp-elapsed-time error call-interactively apply current-time interactive-p) + ;; First, the functions used inside each instrumented function: + '(elp-wrapper called-interactively-p + ;; Then the functions used by the above functions. I used + ;; (delq nil (mapcar (lambda (x) (and (symbolp x) (fboundp x) x)) + ;; (aref (symbol-function 'elp-wrapper) 2))) + ;; to help me find this list. + error call-interactively apply current-time) "List of functions that cannot be profiled. Those functions are used internally by the profiling code and profiling them would thus lead to infinite recursion.") -(defun elp-not-profilable-p (fun) - (or (memq fun elp-not-profilable) - (keymapp fun) - (condition-case nil - (when (subrp (symbol-function fun)) - (eq 'unevalled (cdr (subr-arity (symbol-function fun))))) - (error nil)))) +(defun elp-profilable-p (fun) + (and (symbolp fun) + (fboundp fun) + (not (or (memq fun elp-not-profilable) + (keymapp fun) + (memq (car-safe (symbol-function fun)) '(autoload macro)) + (condition-case nil + (when (subrp (indirect-function fun)) + (eq 'unevalled + (cdr (subr-arity (indirect-function fun))))) + (error nil)))))) ;;;###autoload @@ -237,9 +247,6 @@ FUNSYM must be a symbol of a defined function." (let* ((funguts (symbol-function funsym)) (infovec (vector 0 0 funguts)) (newguts '(lambda (&rest args)))) - ;; We cannot profile functions used internally during profiling. - (when (elp-not-profilable-p funsym) - (error "ELP cannot profile the function: %s" funsym)) ;; we cannot profile macros (and (eq (car-safe funguts) 'macro) (error "ELP cannot profile macro: %s" funsym)) @@ -252,6 +259,9 @@ FUNSYM must be a symbol of a defined function." ;; type functionality (i.e. it shouldn't execute the function). (and (eq (car-safe funguts) 'autoload) (error "ELP cannot profile autoloaded function: %s" funsym)) + ;; We cannot profile functions used internally during profiling. + (unless (elp-profilable-p funsym) + (error "ELP cannot profile the function: %s" funsym)) ;; put rest of newguts together (if (commandp funsym) (setq newguts (append newguts '((interactive))))) @@ -344,18 +354,15 @@ Use optional LIST if provided instead." For example, to instrument all ELP functions, do the following: \\[elp-instrument-package] RET elp- RET" - (interactive "sPrefix of package to instrument: ") + (interactive + (list (completing-read "Prefix of package to instrument: " + obarray 'elp-profilable-p))) (if (zerop (length prefix)) (error "Instrumenting all Emacs functions would render Emacs unusable")) (elp-instrument-list (mapcar 'intern - (all-completions - prefix obarray - (lambda (sym) - (and (fboundp sym) - (not (or (memq (car-safe (symbol-function sym)) '(autoload macro)) - (elp-not-profilable-p sym))))))))) + (all-completions prefix obarray 'elp-profilable-p)))) (defun elp-restore-list (&optional list) "Restore the original definitions for all functions in `elp-function-list'. @@ -488,12 +495,12 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." ;; check for very large or small numbers (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number) (concat (substring - (substring number (match-beginning 1) (match-end 1)) + (match-string 1 number) 0 (- width (match-end 2) (- (match-beginning 2)) 3)) "..." - (substring number (match-beginning 2) (match-end 2))) - (concat (substring number 0 width))))) + (match-string 2 number)) + (substring number 0 width)))) (defun elp-output-result (resultvec) ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or @@ -528,20 +535,15 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." (defvar elp-results-symname-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] 'elp-results-jump-to-definition-by-mouse) + (define-key map [mouse-2] 'elp-results-jump-to-definition) (define-key map "\C-m" 'elp-results-jump-to-definition) map) "Keymap used on the function name column." ) -(defun elp-results-jump-to-definition-by-mouse (event) - "Jump to the definition of the function under the place specified by EVENT." - (interactive "e") - (posn-set-point (event-end event)) - (elp-results-jump-to-definition)) - -(defun elp-results-jump-to-definition () +(defun elp-results-jump-to-definition (&optional event) "Jump to the definition of the function under the point." - (interactive) + (interactive (list last-nonmenu-event)) + (if event (posn-set-point (event-end event))) (find-function (get-text-property (point) 'elp-symname))) (defun elp-output-insert-symname (symname) @@ -550,7 +552,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." 'elp-symname (intern symname) 'keymap elp-results-symname-map 'mouse-face 'highlight - 'help-echo (substitute-command-keys "\\{elp-results-symname-map}")))) + 'help-echo "mouse-2 or RET jumps to definition"))) ;;;###autoload (defun elp-results () @@ -630,5 +632,5 @@ displayed." (provide 'elp) -;;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1 +;; arch-tag: c4eef311-9b3e-4bb2-8a54-3485d41b4eb1 ;;; elp.el ends here diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index d83ebd543cd..0590af50249 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -65,6 +65,7 @@ ;; List of overlays used to display current rectangle. (defvar cua--rectangle-overlays nil) (make-variable-buffer-local 'cua--rectangle-overlays) +(put 'cua--rectangle-overlays 'permanent-local t) (defvar cua--overlay-keymap (let ((map (make-sparse-keymap))) @@ -781,7 +782,7 @@ If command is repeated at same position, delete the rectangle." (make-string (- l cl0 (if (and (= le pl) (/= le lb)) 1 0)) (if cua--virtual-edges-debug ?. ?\s)) - 'face 'default)) + 'face (or (get-text-property (1- s) 'face) 'default))) (if (/= pl le) (setq s (1- s)))) (cond @@ -1393,7 +1394,12 @@ With prefix arg, indent to that column." (if (and mark-active (not deactivate-mark)) (cua--highlight-rectangle) - (cua--deactivate-rectangle))) + (cua--deactivate-rectangle)) + (when cua--rectangle-overlays + ;; clean-up after revert-buffer + (mapcar (function delete-overlay) cua--rectangle-overlays) + (setq cua--rectangle-overlays nil) + (setq deactivate-mark t))) (when cua--rect-undo-set-point (goto-char cua--rect-undo-set-point) (setq cua--rect-undo-set-point nil))) diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 2af0a9bbfa8..c8a5d53b504 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -200,9 +200,10 @@ Enter as a sexp. Examples: \"\\C-z\", [(control ?z)]." :type 'string :group 'viper) -(defcustom viper-ESC-key [(escape)] ; "\e" +(defcustom viper-ESC-key (if (viper-window-display-p) [(escape)] "\e") "Key used to ESC. -Enter as a sexp. Examples: \"\\e\", [(escape)]." +Enter as a sexp. Examples: \"\\e\", [(escape)]. +If running in a terminal, [(escape)] is not understood, so must use \"\\e\"." :type 'sexp :group 'viper :set (lambda (symbol value) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 7bcaf8be399..754eff3906d 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -9,7 +9,7 @@ ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Keywords: emulations -(defconst viper-version "3.11.5 of October 5, 2005" +(defconst viper-version "3.11.5 of November 25, 2005" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -429,7 +429,6 @@ widget." occur-mode mh-folder-mode - mail-mode gnus-group-mode gnus-summary-mode @@ -442,6 +441,8 @@ widget." rcirc-mode + jde-javadoc-checker-report-mode + view-mode vm-mode vm-summary-mode) diff --git a/lisp/files.el b/lisp/files.el index 7bd01f93841..6a049f8f0f1 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3154,7 +3154,7 @@ Uses `backup-directory-alist' in the same way as does This function returns a relative file name which is equivalent to FILENAME when used with that default directory as the default. If FILENAME and DIRECTORY lie on different machines or on different drives -on a DOS/Windows machine, it returns FILENAME on expanded form." +on a DOS/Windows machine, it returns FILENAME in expanded form." (save-match-data (setq directory (file-name-as-directory (expand-file-name (or directory diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 1c9ccff2432..47bc5152501 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -1123,8 +1123,9 @@ delimit the region to fontify." (font-lock-fontify-region (point) (mark))) ((error quit) (message "Fontifying block...%s" error-data))))))) -(if (boundp 'facemenu-keymap) - (define-key facemenu-keymap "\M-o" 'font-lock-fontify-block)) +(unless (featurep 'facemenu) + (error "facemenu must be loaded before font-lock")) +(define-key facemenu-keymap "\M-o" 'font-lock-fontify-block) ;;; End of Fontification functions. diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index b6d62bf9b83..01babcddc86 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,9 @@ +2005-11-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * gnus-delay.el (gnus-delay-group): Don't autoload. + It's useless and could trigger a bug in cus-dep.el causing ldefs-boot + to be re-loaded when customizing the `gnus-delay' group. + 2005-11-19 Chong Yidong <cyd@stupidchicken.com> * message.el: Revert last changes. diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index a664ff8ba00..a427aaefab8 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -39,7 +39,6 @@ (require 'gnus-draft) (autoload 'parse-time-string "parse-time" nil nil) -;;;###autoload (defgroup gnus-delay nil "Arrange for sending postings later." :version "22.1" @@ -195,5 +194,5 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil." ;; coding: iso-8859-1 ;; End: -;;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d +;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d ;;; gnus-delay.el ends here diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 6d95827c3e4..6bc41e7b947 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -223,7 +223,6 @@ KIND should be `var' for a variable or `subr' for a subroutine." (concat "src/" file) file))))) -;;;###autoload (defface help-argument-name '((((supports :slant italic)) :inherit italic)) "Face to highlight argument names in *Help* buffers." :group 'help) @@ -436,7 +435,9 @@ face (according to `face-differs-from-default-p')." (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") + (let ((fill-begin (point))) + (insert (car high) "\n") + (fill-region fill-begin (point))) (setq doc (cdr high)))) (let ((obsolete (and ;; function might be a lambda construct. diff --git a/lisp/help.el b/lisp/help.el index 5141c06981a..cd95af0e866 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -38,7 +38,57 @@ (add-hook 'temp-buffer-setup-hook 'help-mode-setup) (add-hook 'temp-buffer-show-hook 'help-mode-finish) -(defvar help-map (make-sparse-keymap) +(defvar help-map + (let ((map (make-sparse-keymap))) + (define-key map (char-to-string help-char) 'help-for-help) + (define-key map [help] 'help-for-help) + (define-key map [f1] 'help-for-help) + (define-key map "." 'display-local-help) + (define-key map "?" 'help-for-help) + + (define-key map "\C-c" 'describe-copying) + (define-key map "\C-d" 'describe-distribution) + (define-key map "\C-e" 'view-emacs-problems) + (define-key map "\C-f" 'view-emacs-FAQ) + (define-key map "\C-m" 'view-order-manuals) + (define-key map "\C-n" 'view-emacs-news) + (define-key map "\C-p" 'describe-project) + (define-key map "\C-t" 'view-todo) + (define-key map "\C-w" 'describe-no-warranty) + + ;; This does not fit the pattern, but it is natural given the C-\ command. + (define-key map "\C-\\" 'describe-input-method) + + (define-key map "C" 'describe-coding-system) + (define-key map "F" 'Info-goto-emacs-command-node) + (define-key map "I" 'describe-input-method) + (define-key map "K" 'Info-goto-emacs-key-command-node) + (define-key map "L" 'describe-language-environment) + (define-key map "S" 'info-lookup-symbol) + + (define-key map "a" 'apropos-command) + (define-key map "b" 'describe-bindings) + (define-key map "c" 'describe-key-briefly) + (define-key map "d" 'apropos-documentation) + (define-key map "e" 'view-echo-area-messages) + (define-key map "f" 'describe-function) + (define-key map "h" 'view-hello-file) + + (define-key map "i" 'info) + (define-key map "4i" 'info-other-window) + + (define-key map "k" 'describe-key) + (define-key map "l" 'view-lossage) + (define-key map "m" 'describe-mode) + (define-key map "n" 'view-emacs-news) + (define-key map "p" 'finder-by-keyword) + (define-key map "r" 'info-emacs-manual) + (define-key map "s" 'describe-syntax) + (define-key map "t" 'help-with-tutorial) + (define-key map "w" 'where-is) + (define-key map "v" 'describe-variable) + (define-key map "q" 'help-quit) + map) "Keymap for characters following the Help key.") (define-key global-map (char-to-string help-char) 'help-command) @@ -46,73 +96,9 @@ (define-key global-map [f1] 'help-command) (fset 'help-command help-map) -(define-key help-map (char-to-string help-char) 'help-for-help) -(define-key help-map [help] 'help-for-help) -(define-key help-map [f1] 'help-for-help) -(define-key help-map "." 'display-local-help) -(define-key help-map "?" 'help-for-help) - -(define-key help-map "\C-c" 'describe-copying) -(define-key help-map "\C-d" 'describe-distribution) -(define-key help-map "\C-e" 'view-emacs-problems) -(define-key help-map "\C-f" 'view-emacs-FAQ) -(define-key help-map "\C-m" 'view-order-manuals) -(define-key help-map "\C-n" 'view-emacs-news) -(define-key help-map "\C-p" 'describe-project) -(define-key help-map "\C-t" 'view-todo) -(define-key help-map "\C-w" 'describe-no-warranty) - -;; This does not fit the pattern, but it is natural given the C-\ command. -(define-key help-map "\C-\\" 'describe-input-method) - -(define-key help-map "C" 'describe-coding-system) -(define-key help-map "F" 'Info-goto-emacs-command-node) -(define-key help-map "I" 'describe-input-method) -(define-key help-map "K" 'Info-goto-emacs-key-command-node) -(define-key help-map "L" 'describe-language-environment) -(define-key help-map "S" 'info-lookup-symbol) - -(define-key help-map "a" 'apropos-command) - -(define-key help-map "b" 'describe-bindings) - -(define-key help-map "c" 'describe-key-briefly) - -(define-key help-map "d" 'apropos-documentation) - -(define-key help-map "e" 'view-echo-area-messages) - -(define-key help-map "f" 'describe-function) - -(define-key help-map "h" 'view-hello-file) - -(define-key help-map "i" 'info) -(define-key help-map "4i" 'info-other-window) - -(define-key help-map "k" 'describe-key) - -(define-key help-map "l" 'view-lossage) - -(define-key help-map "m" 'describe-mode) - -(define-key help-map "n" 'view-emacs-news) - -(define-key help-map "p" 'finder-by-keyword) (autoload 'finder-by-keyword "finder" "Find packages matching a given keyword." t) -(define-key help-map "r" 'info-emacs-manual) - -(define-key help-map "s" 'describe-syntax) - -(define-key help-map "t" 'help-with-tutorial) - -(define-key help-map "w" 'where-is) - -(define-key help-map "v" 'describe-variable) - -(define-key help-map "q" 'help-quit) - ;; insert-button makes the action nil if it is not store somewhere (defvar help-button-cache nil) @@ -590,7 +576,7 @@ the last key hit are used." (goto-char position))) ;; Ok, now look up the key and name the command. (let ((defn (or (string-key-binding key) - (key-binding key))) + (key-binding key t))) key-desc) ;; Don't bother user with strings from (e.g.) the select-paste menu. (if (stringp (aref key (1- (length key)))) @@ -615,7 +601,7 @@ KEY can be any kind of a key sequence; it can include keyboard events, mouse events, and/or menu events. When calling from a program, pass KEY as a string or a vector. -If non-nil, UNTRANSLATED is a vector of the correspondinguntranslated events. +If non-nil, UNTRANSLATED is a vector of the corresponding untranslated events. It can also be a number, in which case the untranslated events from the last key sequence entered are used." ;; UP-EVENT is the up-event that was discarded by reading KEY, or nil. @@ -635,7 +621,7 @@ the last key sequence entered are used." (when (windowp window) (set-buffer (window-buffer window)) (goto-char position)) - (let ((defn (or (string-key-binding key) (key-binding key)))) + (let ((defn (or (string-key-binding key) (key-binding key t)))) (if (or (null defn) (integerp defn) (equal defn 'undefined)) (message "%s is undefined" (help-key-description key untranslated)) (help-setup-xref (list #'describe-function defn) (interactive-p)) diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index 8d565ab61a8..4c61be5529e 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -89,16 +89,6 @@ :link '(custom-manual "(emacs)Highlight Interactively") :group 'font-lock) -;;;###autoload -(defcustom hi-lock-mode nil - "Toggle hi-lock, for interactively adding font-lock text-highlighting patterns." - :set (lambda (symbol value) - (hi-lock-mode (or value 0))) - :initialize 'custom-initialize-default - :type 'boolean - :group 'hi-lock - :require 'hi-lock) - (defcustom hi-lock-file-patterns-range 10000 "Limit of search in a buffer for hi-lock patterns. When a file is visited and hi-lock mode is on patterns starting @@ -244,19 +234,11 @@ calls." (define-key hi-lock-map "\C-xwr" 'unhighlight-regexp) (define-key hi-lock-map "\C-xwb" 'hi-lock-write-interactive-patterns) -(unless (assq 'hi-lock-mode minor-mode-map-alist) - (setq minor-mode-map-alist (cons (cons 'hi-lock-mode hi-lock-map) - minor-mode-map-alist))) - -(unless (assq 'hi-lock-mode minor-mode-alist) - (setq minor-mode-alist (cons '(hi-lock-mode " H") minor-mode-alist))) - - ;; Visible Functions ;;;###autoload -(defun hi-lock-mode (&optional arg) +(define-minor-mode hi-lock-buffer-mode "Toggle minor mode for interactively adding font-lock highlighting patterns. If ARG positive turn hi-lock on. Issuing a hi-lock command will also @@ -297,43 +279,40 @@ of characters into buffer) `hi-lock-file-patterns-range'. Patterns will be read until Hi-lock: end is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'." - (interactive) - (let ((hi-lock-mode-prev hi-lock-mode)) - (setq hi-lock-mode - (if (null arg) (not hi-lock-mode) - (> (prefix-numeric-value arg) 0))) - ;; Turned on. - (when (and (not hi-lock-mode-prev) hi-lock-mode) - (add-hook 'find-file-hook 'hi-lock-find-file-hook) - (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook) - (if (null (default-value 'font-lock-defaults)) - (setq-default font-lock-defaults '(nil))) - (if (null font-lock-defaults) - (setq font-lock-defaults '(nil))) - (unless font-lock-mode - (font-lock-mode 1)) - (define-key-after menu-bar-edit-menu [hi-lock] - (cons "Regexp Highlighting" hi-lock-menu)) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer (hi-lock-find-patterns)))) + :group 'hi-lock + :lighter " H" + :global nil + :keymap hi-lock-map + (if hi-lock-buffer-mode + ;; Turned on. + (progn + (unless font-lock-mode (font-lock-mode 1)) + (define-key-after menu-bar-edit-menu [hi-lock] + (cons "Regexp Highlighting" hi-lock-menu)) + (hi-lock-find-patterns) + (add-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook nil t)) ;; Turned off. - (when (and hi-lock-mode-prev (not hi-lock-mode)) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (or hi-lock-interactive-patterns hi-lock-file-patterns) - (font-lock-remove-keywords nil hi-lock-interactive-patterns) - (font-lock-remove-keywords nil hi-lock-file-patterns) - (setq hi-lock-interactive-patterns nil - hi-lock-file-patterns nil) - (when font-lock-mode (hi-lock-refontify))))) - - (let ((fld (default-value 'font-lock-defaults))) - (if (and fld (listp fld) (null (car fld))) - (setq-default font-lock-defaults (cdr fld)))) - (define-key-after menu-bar-edit-menu [hi-lock] nil) - (remove-hook 'find-file-hook 'hi-lock-find-file-hook) - (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook)))) + (when (or hi-lock-interactive-patterns + hi-lock-file-patterns) + (when hi-lock-interactive-patterns + (font-lock-remove-keywords nil hi-lock-interactive-patterns) + (setq hi-lock-interactive-patterns nil)) + (when hi-lock-file-patterns + (font-lock-remove-keywords nil hi-lock-file-patterns) + (setq hi-lock-file-patterns nil)) + (if font-lock-mode + (font-lock-fontify-buffer))) + (define-key-after menu-bar-edit-menu [hi-lock] nil) + (remove-hook 'font-lock-mode-hook 'hi-lock-font-lock-hook t))) +;;;###autoload +(define-global-minor-mode hi-lock-mode + hi-lock-buffer-mode turn-on-hi-lock-if-enabled + :group 'hi-lock) + +(defun turn-on-hi-lock-if-enabled () + (unless (memq major-mode hi-lock-exclude-modes) + (hi-lock-buffer-mode 1))) ;;;###autoload (defalias 'highlight-lines-matching-regexp 'hi-lock-line-face-buffer) @@ -352,12 +331,12 @@ list maintained for regexps, global history maintained for faces. (cons (or (car hi-lock-regexp-history) "") 1 ) nil nil 'hi-lock-regexp-history)) (hi-lock-read-face-name))) - (unless hi-lock-mode (hi-lock-mode)) - (or (facep face) (setq face 'rwl-yellow)) + (or (facep face) (setq face 'hi-yellow)) + (unless hi-lock-buffer-mode (hi-lock-buffer-mode 1)) (hi-lock-set-pattern ;; The \\(?:...\\) grouping construct ensures that a leading ^, +, * or ? ;; or a trailing $ in REGEXP will be interpreted correctly. - (list (concat "^.*\\(?:" regexp "\\).*$") (list 0 (list 'quote face) t)))) + (concat "^.*\\(?:" regexp "\\).*$") face)) ;;;###autoload @@ -377,9 +356,9 @@ list maintained for regexps, global history maintained for faces. (cons (or (car hi-lock-regexp-history) "") 1 ) nil nil 'hi-lock-regexp-history)) (hi-lock-read-face-name))) - (or (facep face) (setq face 'rwl-yellow)) - (unless hi-lock-mode (hi-lock-mode)) - (hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t)))) + (or (facep face) (setq face 'hi-yellow)) + (unless hi-lock-buffer-mode (hi-lock-buffer-mode 1)) + (hi-lock-set-pattern regexp face)) ;;;###autoload (defalias 'highlight-phrase 'hi-lock-face-phrase-buffer) @@ -397,9 +376,9 @@ lower-case letters made case insensitive." (cons (or (car hi-lock-regexp-history) "") 1 ) nil nil 'hi-lock-regexp-history))) (hi-lock-read-face-name))) - (or (facep face) (setq face 'rwl-yellow)) - (unless hi-lock-mode (hi-lock-mode)) - (hi-lock-set-pattern (list regexp (list 0 (list 'quote face) t)))) + (or (facep face) (setq face 'hi-yellow)) + (unless hi-lock-buffer-mode (hi-lock-buffer-mode 1)) + (hi-lock-set-pattern regexp face)) ;;;###autoload (defalias 'unhighlight-regexp 'hi-lock-unface-buffer) @@ -451,7 +430,7 @@ interactive functions. \(See `hi-lock-interactive-patterns'.\) (font-lock-remove-keywords nil (list keyword)) (setq hi-lock-interactive-patterns (delq keyword hi-lock-interactive-patterns)) - (hi-lock-refontify)))) + (font-lock-fontify-buffer)))) ;;;###autoload (defun hi-lock-write-interactive-patterns () @@ -461,17 +440,16 @@ Interactively added patterns are those normally specified using `highlight-regexp' and `highlight-lines-matching-regexp'; they can be found in variable `hi-lock-interactive-patterns'." (interactive) - (let ((prefix (format "%s %s:" (or comment-start "") "Hi-lock"))) - (when (> (+ (point) (length prefix)) hi-lock-file-patterns-range) - (beep) - (message - "Warning, inserted keywords not close enough to top of file.")) + (if (null hi-lock-interactive-patterns) + (error "There are no interactive patterns")) + (let ((beg (point))) (mapcar (lambda (pattern) - (insert (format "%s (%s) %s\n" - prefix (prin1-to-string pattern) (or comment-end "")))) - hi-lock-interactive-patterns))) - + (insert (format "Hi-lock: (%s)\n" (prin1-to-string pattern)))) + hi-lock-interactive-patterns) + (comment-region beg (point))) + (when (> (point) hi-lock-file-patterns-range) + (warn "Inserted keywords not close enough to top of file"))) ;; Implementation Functions @@ -513,29 +491,22 @@ not suitable." (length prefix) 0))) '(hi-lock-face-history . 0)))) -(defun hi-lock-find-file-hook () - "Add hi-lock patterns, if present." - (hi-lock-find-patterns)) - -(defun hi-lock-current-line (&optional end) - "Return line number of line at point. -Optional argument END is maximum excursion." - (interactive) - (save-excursion - (beginning-of-line) - (1+ (count-lines 1 (or end (point)))))) - -(defun hi-lock-set-pattern (pattern) - "Add PATTERN to list of interactively highlighted patterns and refontify." - (hi-lock-set-patterns (list pattern))) - -(defun hi-lock-set-patterns (patterns) - "Add PATTERNS to list of interactively highlighted patterns and refontify.." - (dolist (pattern patterns) +(defun hi-lock-set-pattern (regexp face) + "Highlight REGEXP with face FACE." + (let ((pattern (list regexp (list 0 (list 'quote face) t)))) (unless (member pattern hi-lock-interactive-patterns) (font-lock-add-keywords nil (list pattern)) - (add-to-list 'hi-lock-interactive-patterns pattern))) - (hi-lock-refontify)) + (push pattern hi-lock-interactive-patterns) + (let ((buffer-undo-list t) + (inhibit-read-only t) + (mod (buffer-modified-p))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp (point-max) t) + (put-text-property + (match-beginning 0) (match-end 0) 'face face) + (goto-char (match-end 0)))) + (set-buffer-modified-p mod))))) (defun hi-lock-set-file-patterns (patterns) "Replace file patterns list with PATTERNS and refontify." @@ -543,13 +514,7 @@ Optional argument END is maximum excursion." (font-lock-remove-keywords nil hi-lock-file-patterns) (setq hi-lock-file-patterns patterns) (font-lock-add-keywords nil hi-lock-file-patterns) - (hi-lock-refontify))) - -(defun hi-lock-refontify () - "Unfontify then refontify buffer. Used when hi-lock patterns change." - (interactive) - (unless font-lock-mode (font-lock-mode 1)) - (font-lock-fontify-buffer)) + (font-lock-fontify-buffer))) (defun hi-lock-find-patterns () "Find patterns in current buffer for hi-lock." @@ -569,16 +534,17 @@ Optional argument END is maximum excursion." (condition-case nil (setq all-patterns (append (read (current-buffer)) all-patterns)) (error (message "Invalid pattern list expression at %d" - (hi-lock-current-line))))))) - (when hi-lock-mode (hi-lock-set-file-patterns all-patterns)) + (line-number-at-pos))))))) + (when hi-lock-buffer-mode (hi-lock-set-file-patterns all-patterns)) (if (interactive-p) (message "Hi-lock added %d patterns." (length all-patterns)))))) (defun hi-lock-font-lock-hook () "Add hi lock patterns to font-lock's." - (when hi-lock-mode - (font-lock-add-keywords nil hi-lock-file-patterns) - (font-lock-add-keywords nil hi-lock-interactive-patterns))) + (if font-lock-mode + (progn (font-lock-add-keywords nil hi-lock-file-patterns) + (font-lock-add-keywords nil hi-lock-interactive-patterns)) + (hi-lock-buffer-mode -1))) (provide 'hi-lock) diff --git a/lisp/ido.el b/lisp/ido.el index cc4eab4bb4d..a6bd99cdeea 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -899,7 +899,19 @@ The fallback command is passed as an argument to the functions." ;; Persistent variables (defvar ido-mode-map nil - "Keymap for `ido-find-file' and `ido-switch-buffer'.") + "Currently active keymap for ido commands.") + +(defvar ido-mode-common-map nil + "Keymap for all ido commands.") + +(defvar ido-mode-file-map nil + "Keymap for ido file commands.") + +(defvar ido-mode-file-dir-map nil + "Keymap for ido file and directory commands.") + +(defvar ido-mode-buffer-map nil + "Keymap for ido buffer commands.") (defvar ido-file-history nil "History of files selected using `ido-find-file'.") @@ -1301,8 +1313,7 @@ Removes badly formatted data and ignored directories." (while e (setq d (car e) e (cdr e)) (if (not (consp d)) - (set-text-properties 0 (length d) nil d)))))) -) + (set-text-properties 0 (length d) nil d))))))) (defun ido-kill-emacs-hook () @@ -1333,6 +1344,8 @@ This function also adds a hook to the minibuffer." (t nil))) (ido-everywhere (if ido-everywhere 1 -1)) + (when ido-mode + (ido-init-mode-maps)) (when ido-mode (add-hook 'minibuffer-setup-hook 'ido-minibuffer-setup) @@ -1391,12 +1404,11 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise." ;;; IDO KEYMAP -(defun ido-define-mode-map () - "Set up the keymap for `ido'." - (let (map) - ;; generated every time so that it can inherit new functions. +(defun ido-init-mode-maps () + "Set up the keymaps used by `ido'." - (setq map (copy-keymap minibuffer-local-map)) + ;; Common map + (let ((map (make-sparse-keymap))) (define-key map "\C-a" 'ido-toggle-ignore) (define-key map "\C-c" 'ido-toggle-case) (define-key map "\C-e" 'ido-edit-input) @@ -1414,57 +1426,90 @@ With ARG, turn ido speed-up on if arg is positive, off otherwise." (define-key map [right] 'ido-next-match) (define-key map [left] 'ido-prev-match) (define-key map "?" 'ido-completion-help) - ;; Magic commands. (define-key map "\C-b" 'ido-magic-backward-char) (define-key map "\C-f" 'ido-magic-forward-char) (define-key map "\C-d" 'ido-magic-delete-char) + (set-keymap-parent map minibuffer-local-map) + (setq ido-mode-common-map map)) + + ;; File and directory map + (let ((map (make-sparse-keymap))) + (define-key map "\C-x\C-b" 'ido-enter-switch-buffer) + (define-key map "\C-x\C-f" 'ido-fallback-command) + (define-key map "\C-x\C-d" 'ido-enter-dired) + (define-key map [down] 'ido-next-match-dir) + (define-key map [up] 'ido-prev-match-dir) + (define-key map [(meta up)] 'ido-prev-work-directory) + (define-key map [(meta down)] 'ido-next-work-directory) + (define-key map [backspace] 'ido-delete-backward-updir) + (define-key map "\d" 'ido-delete-backward-updir) + (define-key map [(meta backspace)] 'ido-delete-backward-word-updir) + (define-key map [(control backspace)] 'ido-up-directory) + (define-key map "\C-l" 'ido-reread-directory) + (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir) + (define-key map [(meta ?b)] 'ido-push-dir) + (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir) + (define-key map [(meta ?k)] 'ido-forget-work-directory) + (define-key map [(meta ?m)] 'ido-make-directory) + (define-key map [(meta ?n)] 'ido-next-work-directory) + (define-key map [(meta ?o)] 'ido-prev-work-file) + (define-key map [(meta control ?o)] 'ido-next-work-file) + (define-key map [(meta ?p)] 'ido-prev-work-directory) + (define-key map [(meta ?s)] 'ido-merge-work-directories) + (set-keymap-parent map ido-mode-common-map) + (setq ido-mode-file-dir-map map)) + + ;; File only map + (let ((map (make-sparse-keymap))) + (define-key map "\C-k" 'ido-delete-file-at-head) + (define-key map "\C-o" 'ido-copy-current-word) + (define-key map "\C-w" 'ido-copy-current-file-name) + (define-key map [(meta ?l)] 'ido-toggle-literal) + (define-key map "\C-v" 'ido-toggle-vc) + (set-keymap-parent map ido-mode-file-dir-map) + (setq ido-mode-file-map map)) + + ;; Buffer map + (let ((map (make-sparse-keymap))) + (define-key map "\C-x\C-f" 'ido-enter-find-file) + (define-key map "\C-x\C-b" 'ido-fallback-command) + (define-key map "\C-k" 'ido-kill-buffer-at-head) + (set-keymap-parent map ido-mode-common-map) + (setq ido-mode-buffer-map map))) - (when (memq ido-cur-item '(file dir)) - (define-key map "\C-x\C-b" (or ido-context-switch-command 'ido-enter-switch-buffer)) - (define-key map "\C-x\C-f" 'ido-fallback-command) - (define-key map "\C-x\C-d" (or (and ido-context-switch-command 'ignore) 'ido-enter-dired)) - (define-key map [down] 'ido-next-match-dir) - (define-key map [up] 'ido-prev-match-dir) - (define-key map [(meta up)] 'ido-prev-work-directory) - (define-key map [(meta down)] 'ido-next-work-directory) - (define-key map [backspace] 'ido-delete-backward-updir) - (define-key map "\d" 'ido-delete-backward-updir) - (define-key map [(meta backspace)] 'ido-delete-backward-word-updir) - (define-key map [(control backspace)] 'ido-up-directory) - (define-key map "\C-l" 'ido-reread-directory) - (define-key map [(meta ?d)] 'ido-wide-find-dir-or-delete-dir) - (define-key map [(meta ?b)] 'ido-push-dir) - (define-key map [(meta ?f)] 'ido-wide-find-file-or-pop-dir) - (define-key map [(meta ?k)] 'ido-forget-work-directory) - (define-key map [(meta ?m)] 'ido-make-directory) - (define-key map [(meta ?n)] 'ido-next-work-directory) - (define-key map [(meta ?o)] 'ido-prev-work-file) - (define-key map [(meta control ?o)] 'ido-next-work-file) - (define-key map [(meta ?p)] 'ido-prev-work-directory) - (define-key map [(meta ?s)] 'ido-merge-work-directories) - ) - (when (eq ido-cur-item 'file) - (define-key map "\C-k" 'ido-delete-file-at-head) - (define-key map "\C-o" 'ido-copy-current-word) - (define-key map "\C-w" 'ido-copy-current-file-name) - (define-key map [(meta ?l)] 'ido-toggle-literal) - (define-key map "\C-v" 'ido-toggle-vc) - ) +(defun ido-define-mode-map () + "Set up the keymap for `ido'." - (when (eq ido-cur-item 'buffer) - (define-key map "\C-x\C-f" (or ido-context-switch-command 'ido-enter-find-file)) - (define-key map "\C-x\C-b" 'ido-fallback-command) - (define-key map "\C-k" 'ido-kill-buffer-at-head) - ) + ;; generated every time so that it can inherit new functions. + (let ((map (make-sparse-keymap)) + (viper-p (if (boundp 'viper-mode) viper-mode))) - (when (if (boundp 'viper-mode) viper-mode) - (define-key map [remap viper-intercept-ESC-key] 'ignore) - (when (memq ido-cur-item '(file dir)) + (when viper-p + (define-key map [remap viper-intercept-ESC-key] 'ignore)) + + (cond + ((memq ido-cur-item '(file dir)) + (when ido-context-switch-command + (define-key map "\C-x\C-b" ido-context-switch-command) + (define-key map "\C-x\C-d" 'ignore)) + (when viper-p (define-key map [remap viper-backward-char] 'ido-delete-backward-updir) (define-key map [remap viper-del-backward-char-in-insert] 'ido-delete-backward-updir) - (define-key map [remap viper-delete-backward-word] 'ido-delete-backward-word-updir))) + (define-key map [remap viper-delete-backward-word] 'ido-delete-backward-word-updir)) + (set-keymap-parent map + (if (eq ido-cur-item 'file) + ido-mode-file-map + ido-mode-file-dir-map))) + + ((eq ido-cur-item 'buffer) + (when ido-context-switch-command + (define-key map "\C-x\C-f" ido-context-switch-command)) + (set-keymap-parent map ido-mode-buffer-map)) + + (t + (set-keymap-parent map ido-mode-common-map))) (setq ido-mode-map map))) @@ -3625,7 +3670,7 @@ As you type in a string, all of the buffers matching the string are displayed if substring-matching is used \(default). Look at `ido-enable-prefix' and `ido-toggle-prefix'. When you have found the buffer you want, it can then be selected. As you type, most keys have -their normal keybindings, except for the following: \\<ido-mode-map> +their normal keybindings, except for the following: \\<ido-mode-buffer-map> RET Select the buffer at the front of the list of matches. If the list is empty, possibly prompt to create new buffer. @@ -3713,7 +3758,7 @@ type in a string, all of the filenames matching the string are displayed if substring-matching is used \(default). Look at `ido-enable-prefix' and `ido-toggle-prefix'. When you have found the filename you want, it can then be selected. As you type, most keys have their normal keybindings, -except for the following: \\<ido-mode-map> +except for the following: \\<ido-mode-file-map> RET Select the file at the front of the list of matches. If the list is empty, possibly prompt to create new file. @@ -3732,7 +3777,7 @@ in a separate window. \\[ido-merge-work-directories] search for file in the work directory history. \\[ido-forget-work-directory] removes current directory from the work directory history. \\[ido-prev-work-file] or \\[ido-next-work-file] cycle through the work file history. -\\[ido-wide-find-file] and \\[ido-wide-find-dir] prompts and uses find to locate files or directories. +\\[ido-wide-find-file-or-pop-dir] and \\[ido-wide-find-dir-or-delete-dir] prompts and uses find to locate files or directories. \\[ido-make-directory] prompts for a directory to create in current directory. \\[ido-fallback-command] Fallback to non-ido version of current command. \\[ido-toggle-regexp] Toggle regexp searching. diff --git a/lisp/info.el b/lisp/info.el index 84c83bd419b..a00afce7d0a 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -290,8 +290,7 @@ with wrapping around the current Info node." (defvar Info-current-file nil "Info file that Info is now looking at, or nil. This is the name that was specified in Info, not the actual file name. -It doesn't contain directory names or file name extensions added by Info. -Can also be t when using `Info-on-current-buffer'.") +It doesn't contain directory names or file name extensions added by Info.") (defvar Info-current-subfile nil "Info subfile that is actually in the *info* buffer now. @@ -691,12 +690,13 @@ it says do not attempt further (recursive) error recovery." ;; Go into Info buffer. (or (eq major-mode 'Info-mode) (pop-to-buffer "*info*")) ;; Record the node we are leaving. - (if (and Info-current-file (not no-going-back)) + (if (not no-going-back) (setq Info-history (cons (list Info-current-file Info-current-node (point)) Info-history))) (Info-find-node-2 filename nodename no-going-back)) +;;;###autoload (defun Info-on-current-buffer (&optional nodename) "Use the `Info-mode' to browse the current Info buffer. If a prefix arg is provided, it queries for the NODENAME which @@ -708,7 +708,10 @@ else defaults to \"Top\"." (unless nodename (setq nodename "Top")) (info-initialize) (Info-mode) - (set (make-local-variable 'Info-current-file) t) + (set (make-local-variable 'Info-current-file) + (or buffer-file-name + ;; If called on a non-file buffer, make a fake file name. + (concat default-directory (buffer-name)))) (Info-find-node-2 nil nodename)) ;; It's perhaps a bit nasty to kill the *info* buffer to force a re-read, @@ -726,8 +729,7 @@ is preserved, if possible." (pline (count-lines (point-min) (line-beginning-position))) (wline (count-lines (point-min) (window-start))) (old-history Info-history) - (new-history (and Info-current-file - (list Info-current-file Info-current-node (point))))) + (new-history (list Info-current-file Info-current-node (point)))) (kill-buffer (current-buffer)) (Info-find-node filename nodename) (setq Info-history old-history) @@ -1400,12 +1402,10 @@ any double quotes or backslashes must be escaped (\\\",\\\\)." (nconc (propertized-buffer-identification "%b") (list (concat " (" - (file-name-nondirectory - (if (stringp Info-current-file) - Info-current-file - (or buffer-file-name ""))) - ") " - (or Info-current-node "")))))) + (if Info-current-file + (file-name-nondirectory Info-current-file) + " ") + ") " (or Info-current-node "")))))) ;; Go to an Info node specified with a filename-and-nodename string ;; of the sort that is found in pointers in nodes. @@ -1884,7 +1884,7 @@ If SAME-FILE is non-nil, do not move to a different Info file." (let ((old-node Info-current-node) (old-file Info-current-file) (node (Info-extract-pointer "up")) p) - (and (or same-file (not (stringp Info-current-file))) + (and same-file (string-match "^(" node) (error "Up node is in another Info file")) (Info-goto-node node) @@ -3266,12 +3266,8 @@ With a zero prefix arg, put the name inside a function call to `info'." (interactive "P") (unless Info-current-node (error "No current Info node")) - (let ((node (concat "(" (file-name-nondirectory - (or (and (stringp Info-current-file) - Info-current-file) - buffer-file-name - "")) - ")" Info-current-node))) + (let ((node (concat "(" (file-name-nondirectory Info-current-file) ")" + Info-current-node))) (if (zerop (prefix-numeric-value arg)) (setq node (concat "(info \"" node "\")"))) (kill-new node) @@ -3804,23 +3800,19 @@ the variable `Info-file-list-for-emacs'." (and (not (equal (match-string 4) "")) (match-string 4)) (match-string 2))))) - (file (file-name-nondirectory - Info-current-file)) + (file Info-current-file) (hl Info-history-list) res) (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) - (setq file (file-name-nondirectory - (match-string 1 node)) + (setq file (Info-find-file (match-string 1 node) t) node (if (equal (match-string 2 node) "") "Top" (match-string 2 node)))) - (while hl - (if (and (string-equal node (nth 1 (car hl))) - (string-equal file - (file-name-nondirectory - (nth 0 (car hl))))) - (setq res (car hl) hl nil) - (setq hl (cdr hl)))) + (while hl + (if (and (string-equal node (nth 1 (car hl))) + (string-equal file (nth 0 (car hl)))) + (setq res (car hl) hl nil) + (setq hl (cdr hl)))) res))) 'info-xref-visited 'info-xref)) ;; For multiline ref, unfontify newline and surrounding whitespace (save-excursion @@ -3913,22 +3905,19 @@ the variable `Info-file-list-for-emacs'." (let ((node (if (equal (match-string 3) "") (match-string 1) (match-string 3))) - (file (file-name-nondirectory Info-current-file)) + (file Info-current-file) (hl Info-history-list) res) (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) - (setq file (file-name-nondirectory - (match-string 1 node)) + (setq file (Info-find-file (match-string 1 node) t) node (if (equal (match-string 2 node) "") "Top" (match-string 2 node)))) - (while hl - (if (and (string-equal node (nth 1 (car hl))) - (string-equal file - (file-name-nondirectory - (nth 0 (car hl))))) - (setq res (car hl) hl nil) - (setq hl (cdr hl)))) + (while hl + (if (and (string-equal node (nth 1 (car hl))) + (string-equal file (nth 0 (car hl)))) + (setq res (car hl) hl nil) + (setq hl (cdr hl)))) res))) 'info-xref-visited 'info-xref))) (when (and not-fontified-p (memq Info-hide-note-references '(t hide))) (put-text-property (match-beginning 2) (1- (match-end 6)) @@ -4121,7 +4110,7 @@ INDENT is the current indentation depth." NODESPEC is a string of the form: (file)node." (save-excursion ;; Set up a buffer we can use to fake-out Info. - (set-buffer (get-buffer-create "*info-browse-tmp*")) + (set-buffer (get-buffer-create " *info-browse-tmp*")) (if (not (equal major-mode 'Info-mode)) (Info-mode)) ;; Get the node into this buffer diff --git a/lisp/international/latexenc.el b/lisp/international/latexenc.el index c2d24e1a190..15a0d1067e1 100644 --- a/lisp/international/latexenc.el +++ b/lisp/international/latexenc.el @@ -78,7 +78,8 @@ ("next" . next) ; The Next encoding ("utf8" . utf-8) ("utf8x" . utf-8)) ; used by the Unicode LaTeX package - "Mapping from encoding names used by LaTeX's \"inputenc.sty\" to Emacs coding systems. + "Mapping from LaTeX encodings to Emacs coding systems. +LaTeX encodings are specified with \"\\usepackage[encoding]{inputenc}\". Used by the function `latexenc-find-file-coding-system'." :group 'files :group 'mule diff --git a/lisp/isearch.el b/lisp/isearch.el index 9d52ea1b05b..5ccf2bf92ba 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -386,6 +386,8 @@ A value of nil means highlight all matches." (define-key map [iconify-frame] nil) (define-key map [make-frame-visible] nil) (define-key map [mouse-movement] nil) + (define-key map [language-change] nil) + ;; For searching multilingual text. (define-key map "\C-\\" 'isearch-toggle-input-method) (define-key map "\C-^" 'isearch-toggle-specified-input-method) @@ -1138,15 +1140,16 @@ Use `isearch-exit' to quit without signaling." ;; C-s in forward or C-r in reverse. (if (equal isearch-string "") ;; If search string is empty, use last one. - (setq isearch-string - (or (if isearch-regexp - (car regexp-search-ring) - (car search-ring)) - (error "No previous search string")) - isearch-message - (mapconcat 'isearch-text-char-description - isearch-string "") - isearch-case-fold-search isearch-last-case-fold-search) + (if (null (if isearch-regexp regexp-search-ring search-ring)) + (setq isearch-error "No previous search string") + (setq isearch-string + (if isearch-regexp + (car regexp-search-ring) + (car search-ring)) + isearch-message + (mapconcat 'isearch-text-char-description + isearch-string "") + isearch-case-fold-search isearch-last-case-fold-search)) ;; If already have what to search for, repeat it. (or isearch-success (progn diff --git a/lisp/loadup.el b/lisp/loadup.el index 370eeb8aa30..a8e23c41db7 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -134,11 +134,13 @@ (load "frame") (load "term/tty-colors") (load "font-core") +;; facemenu must be loaded before font-lock, because `facemenu-keymap' +;; needs to be defined when font-lock is loaded. +(load "facemenu") (load "emacs-lisp/syntax") (load "font-lock") (load "jit-lock") -(load "facemenu") (if (fboundp 'track-mouse) (progn (load "mouse") diff --git a/lisp/log-edit.el b/lisp/log-edit.el index 54249eb52e3..4c66f7f280b 100644 --- a/lisp/log-edit.el +++ b/lisp/log-edit.el @@ -120,8 +120,10 @@ If SETUP is 'force, this variable has no effect." log-edit-insert-changelog) "*Hook run at the end of `log-edit'." :group 'log-edit - :type '(hook :options (log-edit-insert-cvs-template - log-edit-insert-changelog))) + :type '(hook :options (log-edit-insert-changelog + log-edit-insert-cvs-rcstemplate + log-edit-insert-cvs-template + log-edit-insert-filenames))) (defcustom log-edit-mode-hook (if (boundp 'vc-log-mode-hook) vc-log-mode-hook) "*Hook run when entering `log-edit-mode'." @@ -281,20 +283,13 @@ automatically." (insert "\n")))) ;; Compatibility with old names. -(defvaralias 'vc-comment-ring 'log-edit-comment-ring) -(make-obsolete-variable 'vc-comment-ring 'log-edit-comment-ring "22.1") -(defvaralias 'vc-comment-ring-index 'log-edit-comment-ring-index) -(make-obsolete-variable 'vc-comment-ring-index 'log-edit-comment-ring-index "22.1") -(defalias 'vc-previous-comment 'log-edit-previous-comment) -(make-obsolete 'vc-previous-comment 'log-edit-previous-comment "22.1") -(defalias 'vc-next-comment 'log-edit-next-comment) -(make-obsolete 'vc-next-comment 'log-edit-next-comment "22.1") -(defalias 'vc-comment-search-reverse 'log-edit-comment-search-backward) -(make-obsolete 'vc-comment-search-reverse 'log-edit-comment-search-backward "22.1") -(defalias 'vc-comment-search-forward 'log-edit-comment-search-forward) -(make-obsolete 'vc-comment-search-forward 'log-edit-comment-search-forward "22.1") -(defalias 'vc-comment-to-change-log 'log-edit-comment-to-change-log) -(make-obsolete 'vc-comment-to-change-log 'log-edit-comment-to-change-log "22.1") +(define-obsolete-variable-alias 'vc-comment-ring 'log-edit-comment-ring "22.1") +(define-obsolete-variable-alias 'vc-comment-ring-index 'log-edit-comment-ring-index "22.1") +(define-obsolete-function-alias 'vc-previous-comment 'log-edit-previous-comment "22.1") +(define-obsolete-function-alias 'vc-next-comment 'log-edit-next-comment "22.1") +(define-obsolete-function-alias 'vc-comment-search-reverse 'log-edit-comment-search-backward "22.1") +(define-obsolete-function-alias 'vc-comment-search-forward 'log-edit-comment-search-forward "22.1") +(define-obsolete-function-alias 'vc-comment-to-change-log 'log-edit-comment-to-change-log "22.1") ;;; ;;; Actual code @@ -396,31 +391,6 @@ If you want to abort the commit, simply delete the buffer." "Return the list of files that are about to be committed." (ignore-errors (funcall log-edit-listfun))) - -(defun log-edit-insert-changelog () - "Insert a log message by looking at the ChangeLog. -The idea is to write your ChangeLog entries first, and then use this -command to commit your changes. - -To select default log text, we: -- find the ChangeLog entries for the files to be checked in, -- verify that the top entry in the ChangeLog is on the current date - and by the current user; if not, we don't provide any default text, -- search the ChangeLog entry for paragraphs containing the names of - the files we're checking in, and finally -- use those paragraphs as the log text." - (interactive) - (log-edit-insert-changelog-entries (log-edit-files)) - (log-edit-set-common-indentation) - (goto-char (point-min)) - (when (looking-at "\\*\\s-+") - (forward-line 1) - (when (not (re-search-forward "^\\*\\s-+" nil t)) - (goto-char (point-min)) - (skip-chars-forward "^():") - (skip-chars-forward ": ") - (delete-region (point-min) (point))))) - (defun log-edit-mode-help () "Provide help for the `log-edit-mode-map'." (interactive) @@ -465,11 +435,29 @@ To select default log text, we: (selected-window))))) (defun log-edit-insert-cvs-template () - "Insert the template specified by the CVS administrator, if any." + "Insert the template specified by the CVS administrator, if any. +This simply uses the local CVS/Template file." (interactive) - (when (file-readable-p "CVS/Template") - (insert-file-contents "CVS/Template"))) - + (when (or (interactive-p) (= (point-min) (point-max))) + (when (file-readable-p "CVS/Template") + (insert-file-contents "CVS/Template")))) + +(defun log-edit-insert-cvs-rcstemplate () + "Insert the rcstemplate from the CVS repository. +This contacts the repository to get the rcstemplate file and +can thus take some time." + (interactive) + (when (or (interactive-p) (= (point-min) (point-max))) + (when (file-readable-p "CVS/Root") + ;; Ignore the stderr stuff, even if it's an error. + (call-process "cvs" nil '(t nil) nil + "checkout" "-p" "CVSROOT/rcstemplate")))) + +(defun log-edit-insert-filenames () + "Insert the list of files that are to be committed." + (interactive) + (insert "Affected files: \n" + (mapconcat 'identity (log-edit-files) " \n"))) (defun log-edit-add-to-changelog () "Insert this log message into the appropriate ChangeLog file." @@ -482,6 +470,37 @@ To select default log text, we: (save-excursion (log-edit-comment-to-change-log))))) +(defvar log-edit-changelog-use-first nil) +(defun log-edit-insert-changelog (&optional use-first) + "Insert a log message by looking at the ChangeLog. +The idea is to write your ChangeLog entries first, and then use this +command to commit your changes. + +To select default log text, we: +- find the ChangeLog entries for the files to be checked in, +- verify that the top entry in the ChangeLog is on the current date + and by the current user; if not, we don't provide any default text, +- search the ChangeLog entry for paragraphs containing the names of + the files we're checking in, and finally +- use those paragraphs as the log text. + +If the optional prefix arg USE-FIRST is given (via \\[universal-argument]), +or if the command is repeated a second time in a row, use the first log entry +regardless of user name or time." + (interactive "P") + (let ((log-edit-changelog-use-first + (or use-first (eq last-command 'log-edit-insert-changelog)))) + (log-edit-insert-changelog-entries (log-edit-files))) + (log-edit-set-common-indentation) + (goto-char (point-min)) + (when (looking-at "\\*\\s-+") + (forward-line 1) + (when (not (re-search-forward "^\\*\\s-+" nil t)) + (goto-char (point-min)) + (skip-chars-forward "^():") + (skip-chars-forward ": ") + (delete-region (point-min) (point))))) + ;;;; ;;;; functions for getting commit message from ChangeLog a file... ;;;; Courtesy Jim Blandy @@ -561,7 +580,9 @@ Return non-nil iff it is." (functionp add-log-time-format) (funcall add-log-time-format)) (format-time-string "%Y-%m-%d")))) - (looking-at (regexp-quote (format "%s %s <%s>" time name mail))))) + (looking-at (if log-edit-changelog-use-first + "[^ \t]" + (regexp-quote (format "%s %s <%s>" time name mail)))))) (defun log-edit-changelog-entries (file) "Return the ChangeLog entries for FILE, and the ChangeLog they came from. diff --git a/lisp/longlines.el b/lisp/longlines.el index 93f3daa4ee8..a3912a26ca7 100644 --- a/lisp/longlines.el +++ b/lisp/longlines.el @@ -136,6 +136,7 @@ are indicated with a symbol." ;; Hacks to make longlines play nice with various modes. (cond ((eq major-mode 'mail-mode) + (add-hook 'mail-setup-hook 'longlines-decode-buffer nil t) (or mail-citation-hook (add-hook 'mail-citation-hook 'mail-indent-citation nil t)) (add-hook 'mail-citation-hook 'longlines-decode-region nil t)) @@ -246,17 +247,21 @@ not need to be wrapped, move point to the next line and return t." nil) (if (longlines-merge-lines-p) (progn (end-of-line) - (delete-char 1) ;; After certain commands (e.g. kill-line), there may be two ;; successive soft newlines in the buffer. In this case, we ;; replace these two newlines by a single space. Unfortunately, ;; this breaks the conservation of (spaces + newlines), so we ;; have to fiddle with longlines-wrap-point. - (if (or (bolp) (eolp)) - (if (> longlines-wrap-point (point)) - (setq longlines-wrap-point - (1- longlines-wrap-point))) - (insert-char ? 1)) + (if (or (prog1 (bolp) (forward-char 1)) (eolp)) + (progn + (delete-char -1) + (if (> longlines-wrap-point (point)) + (setq longlines-wrap-point + (1- longlines-wrap-point)))) + (insert-before-markers-and-inherit ?\ ) + (backward-char 1) + (delete-char -1) + (forward-char 1)) nil) (forward-line 1) t))) diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 5f5a53b0df0..0da64128118 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -45,8 +45,6 @@ ;; * A few obscure ls switches are still ignored: see the docstring of ;; `insert-directory'. -;; * Generally only numeric uid/gid. - ;; TO DO ============================================================= ;; Complete handling of F switch (if/when possible). @@ -61,8 +59,8 @@ ;; Revised by Andrew Innes and Geoff Volker (and maybe others). ;; Modified by Francis J. Wright <F.J.Wright@maths.qmw.ac.uk>, mainly -;; to support many more ls options, "platform emulation", hooks for -;; external symbolic link support and more robust sorting. +;; to support many more ls options, "platform emulation" and more +;; robust sorting. ;;; Code: @@ -175,14 +173,6 @@ current year. The OLD-TIME-FORMAT is used for older files. To use ISO (or (featurep 'ls-lisp) ; FJW: unless this file is being reloaded! (setq original-insert-directory (symbol-function 'insert-directory))) -;; This stub is to allow ls-lisp to parse symbolic links via another -;; library such as w32-symlinks.el from -;; http://centaur.maths.qmw.ac.uk/Emacs/: -(defun ls-lisp-parse-symlink (file-name) - "This stub may be redefined to parse FILE-NAME as a symlink. -It should return nil or the link target as a string." - nil) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -429,7 +419,9 @@ SWITCHES is a list of characters. Default sorting is alphabetic." ;; symbolic link, or nil. (let (el dirs files) (while file-alist - (if (eq (cadr (setq el (car file-alist))) t) ; directory + (if (or (eq (cadr (setq el (car file-alist))) t) ; directory + (and (stringp (cadr el)) + (file-directory-p (cadr el)))) ; symlink to a directory (setq dirs (cons el dirs)) (setq files (cons el files))) (setq file-alist (cdr file-alist))) @@ -455,12 +447,11 @@ links, `|' for FIFOs, `=' for sockets, and nothing for regular files. \[But FIFOs and sockets are not recognized.] FILEDATA has the form (filename . `file-attributes'). Its `cadr' is t for directory, string (name linked to) for symbolic link, or nil." - (let ((dir (cadr filedata)) (file-name (car filedata))) - (cond ((or dir - ;; Parsing .lnk files here is perhaps overkill! - (setq dir (ls-lisp-parse-symlink file-name))) + (let ((file-name (car filedata)) + (type (cadr filedata))) + (cond (type (cons - (concat file-name (if (eq dir t) "/" "@")) + (concat file-name (if (eq type t) "/" "@")) (cdr filedata))) ((string-match "x" (nth 9 filedata)) (cons @@ -506,10 +497,6 @@ SWITCHES, TIME-INDEX and NOW give the full switch list and time data." ;; t for directory, string (name linked to) ;; for symbolic link, or nil. (drwxrwxrwx (nth 8 file-attr))) ; attribute string ("drwxrwxrwx") - (and (null file-type) - ;; Maybe no kernel support for symlinks, so... - (setq file-type (ls-lisp-parse-symlink file-name)) - (aset drwxrwxrwx 0 ?l)) ; symbolic link - update attribute string (concat (if (memq ?i switches) ; inode number (format " %6d" (nth 10 file-attr))) ;; nil is treated like "" in concat diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el index aeed54a5ace..1e9a24da341 100644 --- a/lisp/mail/mailheader.el +++ b/lisp/mail/mailheader.el @@ -146,7 +146,7 @@ skip the header altogether if there are no other elements. (insert (capitalize (symbol-name header)) ": " (if (consp value) (car value) value) - hard-newline))) + "\n"))) (defun mail-header-format (format-rules headers) "Use FORMAT-RULES to format HEADERS and insert into current buffer. @@ -187,7 +187,7 @@ A key of nil has as its value a list of defaulted headers to ignore." (if (cdr rule) (funcall (cdr rule) header value) (funcall mail-header-format-function header value)))))) - (insert hard-newline))) + (insert "\n"))) (provide 'mailheader) diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index e87aebe7cc2..242fe788052 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -446,7 +446,7 @@ actually occur.") ;; has been called and has done so. (let ((fill-prefix "\t") (address-start (point))) - (insert to hard-newline) + (insert to "\n") (fill-region-as-paragraph address-start (point-max)) (goto-char (point-max)) (unless (bolp) @@ -455,7 +455,7 @@ actually occur.") (if cc (let ((fill-prefix "\t") (address-start (progn (insert "CC: ") (point)))) - (insert cc hard-newline) + (insert cc "\n") (fill-region-as-paragraph address-start (point-max)) (goto-char (point-max)) (unless (bolp) @@ -464,23 +464,23 @@ actually occur.") (let ((fill-prefix "\t") (fill-column 78) (address-start (point))) - (insert "In-reply-to: " in-reply-to hard-newline) + (insert "In-reply-to: " in-reply-to "\n") (fill-region-as-paragraph address-start (point-max)) (goto-char (point-max)) (unless (bolp) (newline)))) - (insert "Subject: " (or subject "") hard-newline) + (insert "Subject: " (or subject "") "\n") (if mail-default-headers (insert mail-default-headers)) (if mail-default-reply-to - (insert "Reply-to: " mail-default-reply-to hard-newline)) + (insert "Reply-to: " mail-default-reply-to "\n")) (if mail-self-blind - (insert "BCC: " user-mail-address hard-newline)) + (insert "BCC: " user-mail-address "\n")) (if mail-archive-file-name - (insert "FCC: " mail-archive-file-name hard-newline)) + (insert "FCC: " mail-archive-file-name "\n")) (put-text-property (point) (progn - (insert mail-header-separator hard-newline) + (insert mail-header-separator "\n") (1- (point))) 'category 'mail-header-separator) ;; Insert the signature. But remember the beginning of the message. @@ -488,7 +488,7 @@ actually occur.") (cond ((eq mail-signature t) (if (file-exists-p mail-signature-file) (progn - (insert hard-newline hard-newline "-- " hard-newline) + (insert "\n\n-- \n") (insert-file-contents mail-signature-file)))) ((stringp mail-signature) (insert mail-signature)) @@ -835,14 +835,14 @@ the user from the mailer." (split-string new-header-values ",[[:space:]]+" t)) (mapconcat 'identity l ", ")) - hard-newline)) + "\n")) ;; Add Mail-Reply-To if none yet (unless (mail-fetch-field "mail-reply-to") (goto-char (mail-header-end)) (insert "Mail-Reply-To: " (or (mail-fetch-field "reply-to") user-mail-address) - hard-newline)))))) + "\n")))))) (unless (memq mail-send-nonascii '(t mime)) (goto-char (point-min)) (skip-chars-forward "\0-\177") @@ -931,7 +931,7 @@ See also the function `select-message-coding-system'.") fullname-end 1) (replace-match "\\\\\\&" t)) (insert "\"")))) - (insert " <" login ">" hard-newline)) + (insert " <" login ">\n")) ((eq mail-from-style 'parens) (insert "From: " login " (") (let ((fullname-start (point))) @@ -955,9 +955,9 @@ See also the function `select-message-coding-system'.") fullname-end 1) (replace-match "\\1(\\3)" t) (goto-char fullname-start)))) - (insert ")" hard-newline)) + (insert ")\n")) ((null mail-from-style) - (insert "From: " login hard-newline)) + (insert "From: " login "\n")) ((eq mail-from-style 'system-default) nil) (t (error "Invalid value for `mail-from-style'"))))) @@ -996,7 +996,7 @@ external program defined by `sendmail-program'." (goto-char (point-max)) ;; require one newline at the end. (or (= (preceding-char) ?\n) - (insert hard-newline)) + (insert ?\n)) ;; Change header-delimiter to be what sendmail expects. (goto-char (mail-header-end)) (delete-region (point) (progn (end-of-line) (point))) @@ -1008,7 +1008,7 @@ external program defined by `sendmail-program'." ;; Ignore any blank lines in the header (while (and (re-search-forward "\n\n\n*" delimline t) (< (point) delimline)) - (replace-match hard-newline)) + (replace-match "\n")) (goto-char (point-min)) ;; Look for Resent- headers. They require sending ;; the message specially. @@ -1070,10 +1070,10 @@ external program defined by `sendmail-program'." (setq charset (coding-system-get selected-coding 'mime-charset)) (goto-char delimline) - (insert "MIME-version: 1.0" hard-newline + (insert "MIME-version: 1.0\n" "Content-type: text/plain; charset=" - (symbol-name charset) hard-newline - "Content-Transfer-Encoding: 8bit" hard-newline))) + (symbol-name charset) + "\nContent-Transfer-Encoding: 8bit\n"))) ;; Insert an extra newline if we need it to work around ;; Sun's bug that swallows newlines. (goto-char (1+ delimline)) @@ -1167,8 +1167,8 @@ external program defined by `sendmail-program'." (set-buffer tembuf) (erase-buffer) ;; This initial newline is written out if the fcc file already exists. - (insert hard-newline "From " (user-login-name) " " - (current-time-string time) hard-newline) + (insert "\nFrom " (user-login-name) " " + (current-time-string time) "\n") ;; Insert the time zone before the year. (forward-char -1) (forward-word -1) @@ -1178,7 +1178,7 @@ external program defined by `sendmail-program'." (insert-buffer-substring rmailbuf) ;; Make sure messages are separated. (goto-char (point-max)) - (insert hard-newline) + (insert ?\n) (goto-char 2) ;; ``Quote'' "^From " as ">From " ;; (note that this isn't really quoting, as there is no requirement @@ -1220,11 +1220,10 @@ external program defined by `sendmail-program'." (rmail-maybe-set-message-counters) (widen) (narrow-to-region (point-max) (point-max)) - (insert "\C-l" hard-newline "0, unseen,," - hard-newline "*** EOOH ***" hard-newline - "Date: " (mail-rfc822-date) hard-newline) + (insert "\C-l\n0, unseen,,\n*** EOOH ***\n" + "Date: " (mail-rfc822-date) "\n") (insert-buffer-substring curbuf beg2 end) - (insert hard-newline "\C-_") + (insert "\n\C-_") (goto-char (point-min)) (widen) (search-backward "\n\^_") @@ -1262,11 +1261,10 @@ external program defined by `sendmail-program'." (set-buffer (get-buffer-create " mail-temp")) (setq buffer-read-only nil) (erase-buffer) - (insert "\C-l" hard-newline "0, unseen,," hard-newline - "*** EOOH ***" hard-newline "Date: " - (mail-rfc822-date) hard-newline) + (insert "\C-l\n0, unseen,,\n*** EOOH ***\nDate: " + (mail-rfc822-date) "\n") (insert-buffer-substring curbuf beg2 end) - (insert hard-newline "\C-_") + (insert "\n\C-_") (write-region (point-min) (point-max) (car fcc-list) t) (erase-buffer))) (write-region @@ -1318,7 +1316,7 @@ external program defined by `sendmail-program'." (expand-abbrev) (or (mail-position-on-field "cc" t) (progn (mail-position-on-field "to") - (insert hard-newline "CC: ")))) + (insert "\nCC: ")))) (defun mail-bcc () "Move point to end of BCC-field. Create a BCC field if none." @@ -1326,7 +1324,7 @@ external program defined by `sendmail-program'." (expand-abbrev) (or (mail-position-on-field "bcc" t) (progn (mail-position-on-field "to") - (insert hard-newline "BCC: ")))) + (insert "\nBCC: ")))) (defun mail-fcc (folder) "Add a new FCC field, with file name completion." @@ -1334,7 +1332,7 @@ external program defined by `sendmail-program'." (expand-abbrev) (or (mail-position-on-field "fcc" t) ;Put new field after exiting FCC. (mail-position-on-field "to")) - (insert hard-newline "FCC: " folder)) + (insert "\nFCC: " folder)) (defun mail-reply-to () "Move point to end of Reply-To-field. Create a Reply-To field if none." @@ -1349,7 +1347,7 @@ Create a Mail-Reply-To field if none." (expand-abbrev) (or (mail-position-on-field "mail-reply-to" t) (progn (mail-position-on-field "to") - (insert hard-newline "Mail-Reply-To: ")))) + (insert "\nMail-Reply-To: ")))) (defun mail-mail-followup-to () "Move point to end of Mail-Followup-To field. @@ -1358,7 +1356,7 @@ Create a Mail-Followup-To field if none." (expand-abbrev) (or (mail-position-on-field "mail-followup-to" t) (progn (mail-position-on-field "to") - (insert hard-newline "Mail-Followup-To: ")))) + (insert "\nMail-Followup-To: ")))) (defun mail-position-on-field (field &optional soft) (let (end @@ -1373,7 +1371,7 @@ Create a Mail-Followup-To field if none." t) (or soft (progn (goto-char end) - (insert field ": " hard-newline) + (insert field ": \n") (skip-chars-backward "\n"))) nil))) @@ -1396,7 +1394,7 @@ Prefix arg means put contents at point." (delete-region (point) (point-max))) (if (stringp mail-signature) (insert mail-signature) - (insert hard-newline hard-newline "-- " hard-newline) + (insert "\n\n-- \n") (insert-file-contents (expand-file-name mail-signature-file))))) (defun mail-fill-yanked-message (&optional justifyp) @@ -1482,7 +1480,7 @@ and don't delete any header fields." ;; loop would deactivate the mark because we inserted text. (goto-char (prog1 (mark t) (set-marker (mark-marker) (point) (current-buffer)))) - (if (not (eolp)) (insert hard-newline))))) + (if (not (eolp)) (insert ?\n))))) (defun mail-yank-clear-headers (start end) (if (< end start) @@ -1566,8 +1564,7 @@ If the current line has `mail-yank-prefix', insert it on the new line." (insert-char ?= (max 0 (- 60 (current-column)))) (newline) (setq middle (point)) - (insert "============================================================" - hard-newline) + (insert "============================================================\n") (push-mark) (goto-char middle) (insert-file-contents file) diff --git a/lisp/mouse.el b/lisp/mouse.el index 0aab1a99bb6..2c5d9cbddd6 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -371,16 +371,9 @@ That means one whose bottom edge is at the same height as WINDOW's top edge." Move it down if GROWTH is positive, or up if GROWTH is negative. If this would make WINDOW too short, shrink the window or windows above it to make room." - (let ((excess (- window-min-height (+ (window-height window) growth)))) - ;; EXCESS is the number of lines we need to take from windows above. - (if (> excess 0) - ;; This can recursively shrink windows all the way up. - (let ((window-above (mouse-drag-window-above window))) - (if window-above - (mouse-drag-move-window-bottom window-above (- excess)))))) - (save-selected-window - (select-window window) - (enlarge-window growth nil (> growth 0)))) + (condition-case nil + (adjust-window-trailing-edge window growth nil) + (error nil))) (defsubst mouse-drag-move-window-top (window growth) "Move the top of WINDOW up or down by GROWTH lines. diff --git a/lisp/net/goto-addr.el b/lisp/net/goto-addr.el index d86a8ecdf2d..9925227619f 100644 --- a/lisp/net/goto-addr.el +++ b/lisp/net/goto-addr.el @@ -174,6 +174,7 @@ and `goto-address-fontify-p'." (overlay-put this-overlay 'evaporate t) (overlay-put this-overlay 'mouse-face goto-address-url-mouse-face) + (overlay-put this-overlay 'follow-link t) (overlay-put this-overlay 'help-echo "mouse-2, C-c RET: follow URL") (overlay-put this-overlay @@ -189,6 +190,7 @@ and `goto-address-fontify-p'." (overlay-put this-overlay 'evaporate t) (overlay-put this-overlay 'mouse-face goto-address-mail-mouse-face) + (overlay-put this-overlay 'follow-link t) (overlay-put this-overlay 'help-echo "mouse-2, C-c RET: mail this address") (overlay-put this-overlay @@ -210,7 +212,7 @@ Send mail to address at point. See documentation for there, then load the URL at or before point." (interactive (list last-input-event)) (save-excursion - (if event (mouse-set-point event)) + (if event (posn-set-point (event-end event))) (let ((address (save-excursion (goto-address-find-address-at-point)))) (if (and address (save-excursion diff --git a/lisp/paren.el b/lisp/paren.el index ece3ed3c606..2164ac72d39 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -110,14 +110,7 @@ Returns the new status of Show Paren mode (non-nil means on). When Show Paren mode is enabled, any matching parenthesis is highlighted in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time." :global t :group 'paren-showing - ;; Turn off the usual paren-matching method - ;; when this one is turned on. - (if (local-variable-p 'show-paren-mode) - (make-local-variable 'blink-matching-paren-on-screen) - (kill-local-variable 'blink-matching-paren-on-screen)) - (setq blink-matching-paren-on-screen (not show-paren-mode)) - - ;; Now enable or disable the mechanism. + ;; Enable or disable the mechanism. ;; First get rid of the old idle timer. (if show-paren-idle-timer (cancel-timer show-paren-idle-timer)) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index a158ad3f4e0..5faa21d75a2 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1335,19 +1335,18 @@ Optional argument MINOR indicates this is called from ;; jit-lock might fontify some things too late. (set (make-local-variable 'font-lock-support-mode) nil) (set (make-local-variable 'font-lock-maximum-size) nil) - (let ((fld font-lock-defaults)) - (if (and minor fld) + (if minor + (let ((fld font-lock-defaults)) (font-lock-add-keywords nil (compilation-mode-font-lock-keywords)) - (setq font-lock-defaults '(compilation-mode-font-lock-keywords t))) - (if minor (if font-lock-mode (if fld (font-lock-fontify-buffer) (font-lock-change-mode) (turn-on-font-lock)) - (turn-on-font-lock)) - ;; maybe defer font-lock till after derived mode is set up - (run-mode-hooks 'compilation-turn-on-font-lock)))) + (turn-on-font-lock))) + (setq font-lock-defaults '(compilation-mode-font-lock-keywords t)) + ;; maybe defer font-lock till after derived mode is set up + (run-mode-hooks 'compilation-turn-on-font-lock))) ;;;###autoload (define-minor-mode compilation-shell-minor-mode diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index 961ee0747ff..e714fa3d7fb 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -41,7 +41,7 @@ ;; You don't need to know about annotations to use this mode as a debugger, ;; but if you are interested developing the mode itself, then see the ;; Annotations section in the GDB info manual. -;; + ;; GDB developers plan to make the annotation interface obsolete. A new ;; interface called GDB/MI (machine interface) has been designed to replace ;; it. Some GDB/MI commands are used in this file through the CLI command @@ -49,26 +49,32 @@ ;; GDB (6.2 onwards) that uses GDB/MI as the primary interface to GDB. It is ;; still under development and is part of a process to migrate Emacs from ;; annotations to GDB/MI. -;; -;; This mode SHOULD WORK WITH GDB 5.0 ONWARDS but you will NEED GDB 6.0 -;; ONWARDS TO USE WATCH EXPRESSIONS. -;; -;; Windows Platforms: -;; + +;; This mode SHOULD WORK WITH GDB 5.0 onwards but you will NEED GDB 6.0 +;; onwards to use watch expressions. + +;;; Windows Platforms: + ;; If you are using Emacs and GDB on Windows you will need to flush the buffer ;; explicitly in your program if you want timely display of I/O in Emacs. ;; Alternatively you can make the output stream unbuffered, for example, by ;; using a macro: -;; + ;; #ifdef UNBUFFERED ;; setvbuf (stdout, (char *) NULL, _IONBF, 0); ;; #endif -;; + ;; and compiling with -DUNBUFFERED while debugging. -;; -;; Known Bugs: -;; -;; TODO: + +;;; Known Bugs: + +;; 1) Strings that are watched don't update in the speedbar when their +;; contents change. +;; 2) Watch expressions go out of scope when the inferior is re-run. +;; 3) Cannot handle multiple debug sessions. + +;;; TODO: + ;; 1) Use MI command -data-read-memory for memory window. ;; 2) Highlight changed register values (use MI commands ;; -data-list-register-values and -data-list-changed-registers instead @@ -397,6 +403,8 @@ With arg, use separate IO iff arg is positive." 'gdb-mouse-until) (define-key gud-minor-mode-map [left-fringe drag-mouse-1] 'gdb-mouse-until) + (define-key gud-minor-mode-map [left-margin mouse-2] + 'gdb-mouse-until) (define-key gud-minor-mode-map [left-margin mouse-3] 'gdb-mouse-toggle-breakpoint-margin) (define-key gud-minor-mode-map [left-fringe mouse-3] @@ -471,6 +479,21 @@ With arg, use separate IO iff arg is positive." (forward-char 2) (gud-call (concat "until *%a"))))))))) +(defcustom gdb-speedbar-auto-raise t + "If non-nil raise speedbar every time display of watch expressions is\ + updated." + :type 'boolean + :group 'gud + :version "22.1") + +(defun gdb-speedbar-auto-raise (arg) + "Toggle automatic raising of the speedbar for watch expressions." + (interactive "P") + (setq gdb-speedbar-auto-raise + (if (null arg) + (not gdb-speedbar-auto-raise) + (> (prefix-numeric-value arg) 0)))) + (defcustom gdb-use-colon-colon-notation nil "If non-nil use FUN::VAR format to display variables in the speedbar." :type 'boolean @@ -514,19 +537,16 @@ With arg, use separate IO iff arg is positive." (unless (string-equal speedbar-initial-expansion-list-name "GUD") (speedbar-change-initial-expansion-list "GUD")) - (if (or (equal (nth 2 var) "0") - (and (equal (nth 2 var) "1") - (string-match "char \\*" (nth 3 var)))) - (gdb-enqueue-input - (list - (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) - 'gdba) - (concat "server interpreter mi \"-var-evaluate-expression " - (nth 1 var) "\"\n") - (concat "-var-evaluate-expression " (nth 1 var) "\n")) - `(lambda () (gdb-var-evaluate-expression-handler - ,(nth 1 var) nil)))) - (setq gdb-var-changed t))) + (gdb-enqueue-input + (list + (if (eq (buffer-local-value 'gud-minor-mode gud-comint-buffer) + 'gdba) + (concat "server interpreter mi \"-var-evaluate-expression " + (nth 1 var) "\"\n") + (concat "-var-evaluate-expression " (nth 1 var) "\n")) + `(lambda () (gdb-var-evaluate-expression-handler + ,(nth 1 var) nil)))) + (setq gdb-var-changed t)) (if (re-search-forward "Undefined command" nil t) (message-box "Watching expressions requires gdb 6.0 onwards") (message "No symbol \"%s\" in current context." expr))))) @@ -575,16 +595,13 @@ type=\"\\(.*?\\)\"") (if (string-equal (cadr var1) (cadr varchild)) (throw 'child-already-watched nil))) (push varchild var-list) - (if (or (equal (nth 2 varchild) "0") - (and (equal (nth 2 varchild) "1") - (string-match "char \\*" (nth 3 varchild)))) - (gdb-enqueue-input - (list - (concat - "server interpreter mi \"-var-evaluate-expression " - (nth 1 varchild) "\"\n") - `(lambda () (gdb-var-evaluate-expression-handler - ,(nth 1 varchild) nil)))))))) + (gdb-enqueue-input + (list + (concat + "server interpreter mi \"-var-evaluate-expression " + (nth 1 varchild) "\"\n") + `(lambda () (gdb-var-evaluate-expression-handler + ,(nth 1 varchild) nil))))))) (push var var-list))) (setq gdb-var-list (nreverse var-list)))))) @@ -604,16 +621,12 @@ type=\"\\(.*?\\)\"") (catch 'var-found-1 (let ((varnum (match-string 1))) (dolist (var gdb-var-list) - (when (and (string-equal varnum (cadr var)) - (or (equal (nth 2 var) "0") - (and (equal (nth 2 var) "1") - (string-match "char \\*" (nth 3 var))))) - (gdb-enqueue-input - (list - (concat "server interpreter mi \"-var-evaluate-expression " - varnum "\"\n") - `(lambda () (gdb-var-evaluate-expression-handler ,varnum t)))) - (throw 'var-found-1 nil))))))) + (gdb-enqueue-input + (list + (concat "server interpreter mi \"-var-evaluate-expression " + varnum "\"\n") + `(lambda () (gdb-var-evaluate-expression-handler ,varnum t)))) + (throw 'var-found-1 nil)))))) (setq gdb-pending-triggers (delq 'gdb-var-update gdb-pending-triggers)) (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) @@ -1005,6 +1018,7 @@ This filter may simply queue input for a later time." "An annotation handler for `pre-prompt'. This terminates the collection of output from a previous command if that happens to be in effect." + (setq gdb-error nil) (let ((sink gdb-output-sink)) (cond ((eq sink 'user) t) @@ -1097,6 +1111,7 @@ directives." It is just like `gdb-stopping', except that if we already set the output sink to `user' in `gdb-stopping', that is fine." (setq gud-running nil) + (setq gdb-active-process t) (let ((sink gdb-output-sink)) (cond ((eq sink 'inferior) @@ -1458,11 +1473,11 @@ static char *magick[] = { (gdb-put-breakpoint-icon (eq flag ?y) bptno))) (gdb-enqueue-input (list - (concat "list " + (concat gdb-server-prefix "list " (match-string-no-properties 1) ":1\n") 'ignore)) (gdb-enqueue-input - (list "info source\n" + (list (concat gdb-server-prefix "info source\n") `(lambda () (gdb-get-location ,bptno ,line ,flag)))))))))) (end-of-line))))) @@ -1497,7 +1512,7 @@ static char *magick[] = { (list (let ((bptno (get-text-property 0 'gdb-bptno (car (posn-string posn))))) - (concat + (concat gdb-server-prefix (if (get-text-property 0 'gdb-enabled (car (posn-string posn))) "disable " @@ -1523,7 +1538,7 @@ static char *magick[] = { (when (stringp obj) (gdb-enqueue-input (list - (concat + (concat gdb-server-prefix (if (get-text-property 0 'gdb-enabled obj) "disable " "enable ") @@ -1557,7 +1572,7 @@ static char *magick[] = { (suppress-keymap map) (define-key map [menu-bar breakpoints] (cons "Breakpoints" menu)) (define-key map " " 'gdb-toggle-breakpoint) - (define-key map "d" 'gdb-delete-breakpoint) + (define-key map "D" 'gdb-delete-breakpoint) (define-key map "q" 'kill-this-buffer) (define-key map "\r" 'gdb-goto-breakpoint) (define-key map [mouse-2] 'gdb-goto-breakpoint) @@ -1612,7 +1627,7 @@ static char *magick[] = { (defun gdb-goto-breakpoint (&optional event) "Display the breakpoint location specified at current line." (interactive (list last-input-event)) - (if event (mouse-set-point event)) + (if event (posn-set-point (event-end event))) ;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer. (let ((window (get-buffer-window gud-comint-buffer))) (if window (save-selected-window (select-window window)))) @@ -1661,7 +1676,7 @@ static char *magick[] = { (while (< (point) (point-max)) (setq bl (line-beginning-position) el (line-end-position)) - (unless (looking-at "No ") + (when (looking-at "#") (add-text-properties bl el '(mouse-face highlight help-echo "mouse-2, RET: Select frame"))) @@ -1730,14 +1745,15 @@ static char *magick[] = { (defun gdb-get-frame-number () (save-excursion (end-of-line) - (let* ((pos (re-search-backward "^#*\\([0-9]*\\)" nil t)) + (let* ((start (line-beginning-position)) + (pos (re-search-backward "^#*\\([0-9]+\\)" start t)) (n (or (and pos (match-string-no-properties 1)) "0"))) n))) (defun gdb-frames-select (&optional event) "Select the frame and display the relevant source." (interactive (list last-input-event)) - (if event (mouse-set-point event)) + (if event (posn-set-point (event-end event))) (gdb-enqueue-input (list (concat gdb-server-prefix "frame " (gdb-get-frame-number) "\n") 'ignore)) @@ -1790,6 +1806,7 @@ static char *magick[] = { (define-key map "q" 'kill-this-buffer) (define-key map "\r" 'gdb-threads-select) (define-key map [mouse-2] 'gdb-threads-select) + (define-key map [follow-link] 'mouse-face) map)) (defvar gdb-threads-font-lock-keywords @@ -1822,9 +1839,10 @@ static char *magick[] = { (defun gdb-threads-select (&optional event) "Select the thread and display the relevant source." (interactive (list last-input-event)) - (if event (mouse-set-point event)) + (if event (posn-set-point (event-end event))) (gdb-enqueue-input - (list (concat "thread " (gdb-get-thread-number) "\n") 'ignore)) + (list (concat gdb-server-prefix "thread " + (gdb-get-thread-number) "\n") 'ignore)) (gud-display-frame)) @@ -1851,19 +1869,36 @@ static char *magick[] = { (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) (save-excursion (let ((buffer-read-only nil) - bl) + start end) (goto-char (point-min)) (while (< (point) (point-max)) - (setq bl (line-beginning-position)) + (setq start (line-beginning-position)) + (setq end (line-end-position)) (when (looking-at "^[^ ]+") (unless (string-equal (match-string 0) "The") - (put-text-property bl (match-end 0) - 'face font-lock-variable-name-face))) + (put-text-property start (match-end 0) + 'face font-lock-variable-name-face) + (add-text-properties start end + '(help-echo "mouse-2: edit value" + mouse-face highlight)))) (forward-line 1)))))) +(defun gdb-edit-register-value (&optional event) + (interactive (list last-input-event)) + (save-excursion + (if event (posn-set-point (event-end event))) + (beginning-of-line) + (let* ((register (current-word)) + (value (read-string (format "New value (%s): " register)))) + (gdb-enqueue-input + (list (concat gdb-server-prefix "set $" register "=" value "\n") + 'ignore))))) + (defvar gdb-registers-mode-map (let ((map (make-sparse-keymap))) (suppress-keymap map) + (define-key map "\r" 'gdb-edit-register-value) + (define-key map [mouse-2] 'gdb-edit-register-value) (define-key map " " 'toggle-gdb-all-registers) (define-key map "q" 'kill-this-buffer) map)) @@ -1907,9 +1942,9 @@ static char *magick[] = { (setq gdb-all-registers nil) (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) (setq mode-name "Registers:"))) - (setq gdb-all-registers t) - (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) - (setq mode-name "Registers:All"))) + (setq gdb-all-registers t) + (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) + (setq mode-name "Registers:All"))) (gdb-invalidate-registers)) @@ -2245,13 +2280,13 @@ corresponding to the mode line clicked." "Keymap to create watch expression of a complex data type local variable.") (defconst gdb-struct-string - (concat (propertize "[struct/union];" + (concat (propertize "[struct/union]" 'mouse-face 'highlight 'help-echo "mouse-2: create watch expression" 'local-map gdb-locals-watch-keymap) "\n")) (defconst gdb-array-string - (concat " " (propertize "[array];" + (concat " " (propertize "[array]" 'mouse-face 'highlight 'help-echo "mouse-2: create watch expression" 'local-map gdb-locals-watch-keymap) "\n")) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index e045ae76a29..81ae4c3cd02 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -52,6 +52,7 @@ (defvar gdb-show-changed-values) (defvar gdb-var-changed) (defvar gdb-var-list) +(defvar gdb-speedbar-auto-raise) (defvar tool-bar-map) ;; ====================================================================== @@ -410,6 +411,10 @@ t means that there is no stack, and we are in display-file mode.") (memq gud-minor-mode '(gdbmi gdba)))] ["Delete expression" gdb-var-delete (with-current-buffer gud-comint-buffer + (memq gud-minor-mode '(gdbmi gdba)))] + ["Auto raise frame" gdb-speedbar-auto-raise + :style toggle :selected gdb-speedbar-auto-raise + :visible (with-current-buffer gud-comint-buffer (memq gud-minor-mode '(gdbmi gdba)))]) "Additional menu items to add to the speedbar frame.") @@ -444,16 +449,18 @@ required by the caller." (looking-at "Watch Expressions:"))))) (erase-buffer) (insert "Watch Expressions:\n") + (if gdb-speedbar-auto-raise + (raise-frame speedbar-frame)) (let ((var-list gdb-var-list)) (while var-list - (let* ((depth 0) (start 0) (char ?+) + (let* (char (depth 0) (start 0) (var (car var-list)) (varnum (nth 1 var))) (while (string-match "\\." varnum start) (setq depth (1+ depth) start (1+ (match-beginning 0)))) (if (or (equal (nth 2 var) "0") (and (equal (nth 2 var) "1") - (string-match "char \\*" (nth 3 var)))) + (string-match "char \\*$" (nth 3 var)))) (speedbar-make-tag-line 'bracket ?? nil nil (concat (car var) "\t" (nth 4 var)) 'gdb-edit-value @@ -463,12 +470,25 @@ required by the caller." 'font-lock-warning-face nil) depth) (if (and (cadr var-list) - (string-match varnum (cadr (cadr var-list)))) - (setq char ?-)) + (string-match (concat varnum "\\.") + (cadr (cadr var-list)))) + (setq char ?-) + (setq char ?+)) + (if (string-match "\\*$" (nth 3 var)) + (speedbar-make-tag-line 'bracket char + 'gdb-speedbar-expand-node varnum + (concat (car var) "\t" + (nth 3 var)"\t" + (nth 4 var)) + 'gdb-edit-value nil + (if (and (nth 5 var) + gdb-show-changed-values) + 'font-lock-warning-face + nil) depth) (speedbar-make-tag-line 'bracket char 'gdb-speedbar-expand-node varnum (concat (car var) "\t" (nth 3 var)) - nil nil nil depth))) + nil nil nil depth)))) (setq var-list (cdr var-list)))) (setq gdb-var-changed nil))) (t (if (and (save-excursion @@ -556,6 +576,11 @@ required by the caller." ;; they are found. (while (string-match "\n\032\032\\(.*\\)\n" gud-marker-acc) (let ((match (match-string 1 gud-marker-acc))) + + ;; Pick up stopped annotation if attaching to process. + (if (string-equal match "stopped") (setq gdb-active-process t)) + + ;; Using annotations, switch to gud-gdba-marker-filter. (when (string-equal match "prompt") (require 'gdb-ui) (gdb-prompt nil)) @@ -569,6 +594,8 @@ required by the caller." ;; Set the accumulator to the remaining text. gud-marker-acc (substring gud-marker-acc (match-end 0))) + + ;; Pick up any errors that occur before first prompt annotation. (if (string-equal match "error-begin") (put-text-property 0 (length gud-marker-acc) 'face font-lock-warning-face @@ -3079,6 +3106,8 @@ class of the file (using s to separate nested class ids)." ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face)) ("^\\s-*\\([a-z]+\\)" (1 font-lock-keyword-face)))) +;; FIXME: The keyword "end" associated with "document" +;; should have font-lock-keyword-face (currently font-lock-doc-face). (defvar gdb-script-font-lock-syntactic-keywords '(("^document\\s-.*\\(\n\\)" (1 "< b")) ;; It would be best to change the \n in front, but it's more difficult. diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el index 4f0875bbf99..67b5b108fa5 100644 --- a/lisp/progmodes/octave-inf.el +++ b/lisp/progmodes/octave-inf.el @@ -220,6 +220,13 @@ startup file, `~/.emacs-octave'." (concat (mapconcat 'identity inferior-octave-output-list "\n") "\n")))) + + ;; An empty secondary prompt, as e.g. obtained by '--braindead', + ;; means trouble. + (inferior-octave-send-list-and-digest (list "PS2\n")) + (if (string-match "^PS2 = *$" (car inferior-octave-output-list)) + (inferior-octave-send-list-and-digest (list "PS2 = \"> \"\n"))) + ;; O.k., now we are ready for the Inferior Octave startup commands. (let* (commands (program (file-name-nondirectory inferior-octave-program)) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index f6928a72554..5728499db43 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1002,6 +1002,8 @@ Point is at the beginning of the next line." ;; The list of special chars is taken from the single-unix spec ;; of the shell command language (under `quoting') but with `$' removed. `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol) + ;; In a '...' the backslash is not escaping. + ("\\(\\\\\\)'" 1 ,sh-st-punc) ;; Make sure $@ and @? are correctly recognized as sexps. ("\\$\\([?@]\\)" 1 ,sh-st-symbol) ;; Find HEREDOC starters and add a corresponding rule for the ender. diff --git a/lisp/recentf.el b/lisp/recentf.el index b14997d604f..287ab3014cb 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -813,39 +813,49 @@ See `recentf-arrange-rules' for details on MATCHER." Arrange them in sub-menus following rules in `recentf-arrange-rules'." (if (not recentf-arrange-rules) l - (let ((menus (mapcar #'(lambda (r) (list (car r))) - recentf-arrange-rules)) - menu others min file rules elts count) + (let* ((strip (assq t recentf-arrange-rules)) + (rules (remq strip recentf-arrange-rules)) + (menus (mapcar #'(lambda (r) (list (car r))) rules)) + others l1 l2 menu file min count) + ;; Put menu items into sub-menus as defined by rules. (dolist (elt l) - (setq file (recentf-menu-element-value elt) - rules recentf-arrange-rules - elts menus - menu nil) - (while (and (not menu) rules) - (when (recentf-match-rule-p (cdar rules) file) - (setq menu (car elts)) + (setq l1 menus ;; List of sub-menus + l2 rules ;; List of corresponding matchers. + file (recentf-menu-element-value elt) + menu nil) + ;; Apply the strip suffix rule. + (while (recentf-match-rule-p (cdr strip) file) + (setq file (substring file 0 (match-beginning 0)))) + ;; Search which sub-menu to put the menu item into. + (while (and (not menu) l2) + (when (recentf-match-rule-p (cdar l2) file) + (setq menu (car l1)) (recentf-set-menu-element-value menu (cons elt (recentf-menu-element-value menu)))) - (setq rules (cdr rules) - elts (cdr elts))) - (unless menu - (push elt others))) - - (setq l nil - min (if (natnump recentf-arrange-by-rules-min-items) - recentf-arrange-by-rules-min-items 0)) + (setq l1 (cdr l1) + l2 (cdr l2))) + ;; Put unmatched menu items in the `others' bin. + (or menu (push elt others))) + ;; Finalize the sub-menus. That is, for each one: + ;; - truncate it depending on the value of + ;; `recentf-arrange-by-rules-min-items', + ;; - replace %d by the number of menu items, + ;; - apply `recentf-arrange-by-rule-subfilter' to menu items. + (setq min (if (natnump recentf-arrange-by-rules-min-items) + recentf-arrange-by-rules-min-items 0) + l2 nil) (dolist (menu menus) - (when (setq elts (recentf-menu-element-value menu)) - (setq count (length elts)) + (when (setq l1 (recentf-menu-element-value menu)) + (setq count (length l1)) (if (< count min) - (setq others (nconc elts others)) + (setq others (nconc l1 others)) (recentf-set-menu-element-item menu (format (recentf-menu-element-item menu) count)) (recentf-set-menu-element-value menu (recentf-apply-menu-filter - recentf-arrange-by-rule-subfilter (nreverse elts))) - (push menu l)))) - + recentf-arrange-by-rule-subfilter (nreverse l1))) + (push menu l2)))) + ;; Add the menu items remaining in the `others' bin. (if (and (stringp recentf-arrange-by-rule-others) others) (nreverse (cons @@ -853,12 +863,11 @@ Arrange them in sub-menus following rules in `recentf-arrange-rules'." (format recentf-arrange-by-rule-others (length others)) (recentf-apply-menu-filter recentf-arrange-by-rule-subfilter (nreverse others))) - l)) + l2)) (nconc - (nreverse l) + (nreverse l2) (recentf-apply-menu-filter - recentf-arrange-by-rule-subfilter (nreverse others))))) - )) + recentf-arrange-by-rule-subfilter (nreverse others))))))) ;;; Predefined rule based menu filters ;; @@ -870,12 +879,20 @@ Rules obey `recentf-arrange-rules' format." (dolist (mode auto-mode-alist) (setq regexp (car mode) mode (cdr mode)) - (when (symbolp mode) - (setq rule-name (symbol-name mode)) - (if (string-match "\\(.*\\)-mode$" rule-name) - (setq rule-name (match-string 1 rule-name))) - (setq rule-name (concat rule-name " (%d)") - rule (assoc rule-name rules)) + (when mode + (cond + ;; Build a special "strip suffix" rule from entries of the + ;; form (REGEXP FUNCTION NON-NIL). Notice that FUNCTION is + ;; ignored by the menu filter. So in some corner cases a + ;; wrong mode could be guessed. + ((and (consp mode) (cadr mode)) + (setq rule-name t)) + ((and mode (symbolp mode)) + (setq rule-name (symbol-name mode)) + (if (string-match "\\(.*\\)-mode$" rule-name) + (setq rule-name (match-string 1 rule-name))) + (setq rule-name (concat rule-name " (%d)")))) + (setq rule (assoc rule-name rules)) (if rule (setcdr rule (cons regexp (cdr rule))) (push (list rule-name regexp) rules)))) diff --git a/lisp/replace.el b/lisp/replace.el index e74b8690c28..fbfa1be09c2 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -693,6 +693,7 @@ a previously found match." (defvar occur-mode-map (let ((map (make-sparse-keymap))) + ;; We use this alternative name, so we can use \\[occur-mode-mouse-goto]. (define-key map [mouse-2] 'occur-mode-mouse-goto) (define-key map "\C-c\C-c" 'occur-mode-goto-occurrence) (define-key map "\C-m" 'occur-mode-goto-occurrence) @@ -746,18 +747,6 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. "Handle `revert-buffer' for Occur mode buffers." (apply 'occur-1 (append occur-revert-arguments (list (buffer-name))))) -(defun occur-mode-mouse-goto (event) - "In Occur mode, go to the occurrence whose line you click on." - (interactive "e") - (let (pos) - (save-excursion - (set-buffer (window-buffer (posn-window (event-end event)))) - (save-excursion - (goto-char (posn-point (event-end event))) - (setq pos (occur-mode-find-occurrence)))) - (switch-to-buffer-other-window (marker-buffer pos)) - (goto-char pos))) - (defun occur-mode-find-occurrence () (let ((pos (get-text-property (point) 'occur-target))) (unless pos @@ -766,11 +755,23 @@ Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. (error "Buffer for this occurrence was killed")) pos)) -(defun occur-mode-goto-occurrence () +(defalias 'occur-mode-mouse-goto 'occur-mode-goto-occurrence) +(defun occur-mode-goto-occurrence (&optional event) "Go to the occurrence the current line describes." - (interactive) - (let ((pos (occur-mode-find-occurrence))) - (switch-to-buffer (marker-buffer pos)) + (interactive (list last-nonmenu-event)) + (let ((pos + (if (null event) + ;; Actually `event-end' works correctly with a nil argument as + ;; well, so we could dispense with this test, but let's not + ;; rely on this undocumented behavior. + (occur-mode-find-occurrence) + (with-current-buffer (window-buffer (posn-window (event-end event))) + (save-excursion + (goto-char (posn-point (event-end event))) + (occur-mode-find-occurrence))))) + same-window-buffer-names + same-window-regexps) + (pop-to-buffer (marker-buffer pos)) (goto-char pos))) (defun occur-mode-goto-occurrence-other-window () @@ -832,7 +833,8 @@ Compatibility function for \\[next-error] invocations." (goto-char (cond (reset (point-min)) ((< argp 0) (line-beginning-position)) - ((line-end-position)))) + ((> argp 0) (line-end-position)) + ((point)))) (occur-find-match (abs argp) (if (> 0 argp) @@ -1089,8 +1091,7 @@ See also `multi-occur'." (marker nil) (curstring "") (headerpt (with-current-buffer out-buf (point)))) - (save-excursion - (set-buffer buf) + (with-current-buffer buf (or coding ;; Set CODING only if the current buffer locally ;; binds buffer-file-coding-system. @@ -1223,42 +1224,43 @@ C-l to clear the screen, redisplay, and offer same replacement again, E to edit the replacement string" "Help message while in `query-replace'.") -(defvar query-replace-map (make-sparse-keymap) +(defvar query-replace-map + (let ((map (make-sparse-keymap))) + (define-key map " " 'act) + (define-key map "\d" 'skip) + (define-key map [delete] 'skip) + (define-key map [backspace] 'skip) + (define-key map "y" 'act) + (define-key map "n" 'skip) + (define-key map "Y" 'act) + (define-key map "N" 'skip) + (define-key map "e" 'edit-replacement) + (define-key map "E" 'edit-replacement) + (define-key map "," 'act-and-show) + (define-key map "q" 'exit) + (define-key map "\r" 'exit) + (define-key map [return] 'exit) + (define-key map "." 'act-and-exit) + (define-key map "\C-r" 'edit) + (define-key map "\C-w" 'delete-and-edit) + (define-key map "\C-l" 'recenter) + (define-key map "!" 'automatic) + (define-key map "^" 'backup) + (define-key map "\C-h" 'help) + (define-key map [f1] 'help) + (define-key map [help] 'help) + (define-key map "?" 'help) + (define-key map "\C-g" 'quit) + (define-key map "\C-]" 'quit) + (define-key map "\e" 'exit-prefix) + (define-key map [escape] 'exit-prefix) + map) "Keymap that defines the responses to questions in `query-replace'. The \"bindings\" in this map are not commands; they are answers. The valid answers include `act', `skip', `act-and-show', `exit', `act-and-exit', `edit', `delete-and-edit', `recenter', `automatic', `backup', `exit-prefix', and `help'.") -(define-key query-replace-map " " 'act) -(define-key query-replace-map "\d" 'skip) -(define-key query-replace-map [delete] 'skip) -(define-key query-replace-map [backspace] 'skip) -(define-key query-replace-map "y" 'act) -(define-key query-replace-map "n" 'skip) -(define-key query-replace-map "Y" 'act) -(define-key query-replace-map "N" 'skip) -(define-key query-replace-map "e" 'edit-replacement) -(define-key query-replace-map "E" 'edit-replacement) -(define-key query-replace-map "," 'act-and-show) -(define-key query-replace-map "q" 'exit) -(define-key query-replace-map "\r" 'exit) -(define-key query-replace-map [return] 'exit) -(define-key query-replace-map "." 'act-and-exit) -(define-key query-replace-map "\C-r" 'edit) -(define-key query-replace-map "\C-w" 'delete-and-edit) -(define-key query-replace-map "\C-l" 'recenter) -(define-key query-replace-map "!" 'automatic) -(define-key query-replace-map "^" 'backup) -(define-key query-replace-map "\C-h" 'help) -(define-key query-replace-map [f1] 'help) -(define-key query-replace-map [help] 'help) -(define-key query-replace-map "?" 'help) -(define-key query-replace-map "\C-g" 'quit) -(define-key query-replace-map "\C-]" 'quit) -(define-key query-replace-map "\e" 'exit-prefix) -(define-key query-replace-map [escape] 'exit-prefix) - (defun replace-match-string-symbols (n) "Process a list (and any sub-lists), expanding certain symbols. Symbol Expands To diff --git a/lisp/simple.el b/lisp/simple.el index a1be91f5abf..302354dff26 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -609,7 +609,7 @@ In binary overwrite mode, this function does overwrite, and octal digits are interpreted as a character code. This is intended to be useful for editing binary files." (interactive "*p") - (let* ((char (let (translation-table-for-input) + (let* ((char (let (translation-table-for-input input-method-function) (if (or (not overwrite-mode) (eq overwrite-mode 'overwrite-mode-binary)) (read-quoted-char) @@ -3330,7 +3330,7 @@ and more reliable (no dependence on goal column, etc.)." ;; When adding a newline, don't expand an abbrev. (let ((abbrev-mode nil)) (end-of-line) - (insert hard-newline)) + (insert (if use-hard-newlines hard-newline "\n"))) (line-move arg nil nil try-vscroll)) (if (interactive-p) (condition-case nil @@ -4263,7 +4263,11 @@ of the buffer appears in the mode line." (defcustom blink-matching-paren-on-screen t "*Non-nil means show matching open-paren when it is on screen. If nil, means don't show it (but the open-paren can still be shown -when it is off screen)." +when it is off screen). + +This variable has no effect if `blink-matching-paren' is nil. +\(In that case, the open-paren is never shown.) +It is also ignored if `show-paren-mode' is enabled." :type 'boolean :group 'paren-blinking) @@ -4324,7 +4328,7 @@ If nil, search stops at the beginning of the accessible portion of the buffer." ;; The cdr might hold a new paren-class info rather than ;; a matching-char info, in which case the two CDRs ;; should match. - (eq matching-paren (cdr (syntax-after oldpos))))) + (eq matching-paren (cdr (syntax-after (1- oldpos)))))) (message "Mismatched parentheses")) ((not blinkpos) (if (not blink-matching-paren-distance) @@ -4332,10 +4336,11 @@ If nil, search stops at the beginning of the accessible portion of the buffer." ((pos-visible-in-window-p blinkpos) ;; Matching open within window, temporarily move to blinkpos but only ;; if `blink-matching-paren-on-screen' is non-nil. - (when blink-matching-paren-on-screen - (save-excursion - (goto-char blinkpos) - (sit-for blink-matching-delay)))) + (and blink-matching-paren-on-screen + (not show-paren-mode) + (save-excursion + (goto-char blinkpos) + (sit-for blink-matching-delay)))) (t (save-excursion (goto-char blinkpos) @@ -4514,7 +4519,8 @@ See also `read-mail-command' concerning reading mail." (unless (member-ignore-case (car (car other-headers)) '("in-reply-to" "cc" "body")) (insert (car (car other-headers)) ": " - (cdr (car other-headers)) hard-newline)) + (cdr (car other-headers)) + (if use-hard-newlines hard-newline "\n"))) (setq other-headers (cdr other-headers))) (when body (forward-line 1) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index e09c0d734cc..a48f480a756 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -331,6 +331,16 @@ display is used instead." :group 'speedbar :type 'boolean) +(defcustom speedbar-default-position 'left-right + "*Default position of the speedbar frame. +Possible values are 'left, 'right or 'left-right. +If value is 'left-right, the most suitable location is +determined automatically." + :group 'speedbar + :type '(radio (const :tag "Automatic" left-right) + (const :tag "Left" left) + (const :tag "Right" right))) + (defcustom speedbar-sort-tags nil "*If non-nil, sort tags in the speedbar display. *Obsolete*. Use `semantic-tag-hierarchy-method' instead." @@ -967,7 +977,7 @@ supported at a time. (t (dframe-reposition-frame speedbar-frame (dframe-attached-frame speedbar-frame) - 'left-right)))) + speedbar-default-position)))) (defun speedbar-detach () "Detach the current Speedbar from auto-updating. diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index 7912bb1a4d6..66a633d6f36 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -1085,6 +1085,9 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") (put 'return 'ascii-character ?\C-m) (put 'escape 'ascii-character ?\e) +;; Modifier name `ctrl' is an alias of `control'. +(put 'ctrl 'modifier-value (get 'control 'modifier-value)) + ;;;; Script codes and coding systems (defconst mac-script-code-coding-systems @@ -1962,10 +1965,10 @@ Switch to a buffer editing the last file dropped." user-login-name user-real-login-name user-full-name)) (set v (decode-coding-string (symbol-value v) mac-system-coding-system)))) -;; If Emacs is started from the Finder, change the default directory -;; to the user's home directory. -(if (string= default-directory "/") - (cd "~")) +;; Now the default directory is changed to the user's home directory +;; in emacs.c if invoked from the WindowServer (with -psn_* option). +;; (if (string= default-directory "/") +;; (cd "~")) ;; Darwin 6- pty breakage is now controlled from the C code so that ;; it applies to all builds on darwin. See s/darwin.h PTY_ITERATION. diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index ffa7d606a95..aff6d032f06 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -1039,6 +1039,8 @@ XConsortium: rgb.txt,v 10.41 94/02/20 18:39:36 rws Exp") (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame global-map) +(define-key function-key-map [S-tab] [backtab]) + ;;; Do the actual Windows setup here; the above code just defines ;;; functions and variables that we use now. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index dd718e21ed9..a0f36f5f794 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -501,23 +501,29 @@ in your .emacs file. ;;*---------------------------------------------------------------------*/ ;;* flyspell-accept-buffer-local-defs ... */ ;;*---------------------------------------------------------------------*/ +(defvar flyspell-last-buffer nil + "The buffer in which the last flyspell operation took place.") + (defun flyspell-accept-buffer-local-defs () - ;; strange problem. If buffer in current window has font-lock turned on, - ;; but SET-BUFFER was called to point to an invisible buffer, this ispell - ;; call will reset the buffer to the buffer in the current window. However, - ;; it only happens at startup (fix by Albert L. Ting). - (save-current-buffer - (ispell-accept-buffer-local-defs)) - (if (not (and (eq flyspell-dash-dictionary ispell-dictionary) - (eq flyspell-dash-local-dictionary ispell-local-dictionary))) + ;; When flyspell-word is used inside a loop (e.g. when processing + ;; flyspell-changes), the calls to `ispell-accept-buffer-local-defs' end + ;; up dwarfing everything else, so only do it when the buffer has changed. + (unless (eq flyspell-last-buffer (current-buffer)) + (setq flyspell-last-buffer (current-buffer)) + ;; Strange problem: If buffer in current window has font-lock turned on, + ;; but SET-BUFFER was called to point to an invisible buffer, this ispell + ;; call will reset the buffer to the buffer in the current window. + ;; However, it only happens at startup (fix by Albert L. Ting). + (save-current-buffer + (ispell-accept-buffer-local-defs)) + (unless (and (eq flyspell-dash-dictionary ispell-dictionary) + (eq flyspell-dash-local-dictionary ispell-local-dictionary)) ;; The dictionary has changed - (progn - (setq flyspell-dash-dictionary ispell-dictionary) - (setq flyspell-dash-local-dictionary ispell-local-dictionary) - (if (member (or ispell-local-dictionary ispell-dictionary) - flyspell-dictionaries-that-consider-dash-as-word-delimiter) - (setq flyspell-consider-dash-as-word-delimiter-flag t) - (setq flyspell-consider-dash-as-word-delimiter-flag nil))))) + (setq flyspell-dash-dictionary ispell-dictionary) + (setq flyspell-dash-local-dictionary ispell-local-dictionary) + (setq flyspell-consider-dash-as-word-delimiter-flag + (member (or ispell-local-dictionary ispell-dictionary) + flyspell-dictionaries-that-consider-dash-as-word-delimiter))))) ;;*---------------------------------------------------------------------*/ ;;* flyspell-mode-on ... */ @@ -543,9 +549,7 @@ in your .emacs file. ;; we bound flyspell action to pre-command hook (add-hook 'pre-command-hook (function flyspell-pre-command-hook) t t) ;; we bound flyspell action to after-change hook - (make-local-variable 'after-change-functions) - (setq after-change-functions - (cons 'flyspell-after-change-function after-change-functions)) + (add-hook 'after-change-functions 'flyspell-after-change-function nil t) ;; set flyspell-generic-check-word-p based on the major mode (let ((mode-predicate (get major-mode 'flyspell-mode-predicate))) (if mode-predicate @@ -650,8 +654,7 @@ not the very same deplacement command." ;; we remove the hooks (remove-hook 'post-command-hook (function flyspell-post-command-hook) t) (remove-hook 'pre-command-hook (function flyspell-pre-command-hook) t) - (setq after-change-functions (delq 'flyspell-after-change-function - after-change-functions)) + (remove-hook 'after-change-functions 'flyspell-after-change-function t) ;; we remove all the flyspell hilightings (flyspell-delete-all-overlays) ;; we have to erase pre cache variables @@ -704,14 +707,14 @@ before the current command." ;;* position has to be spell checked. */ ;;*---------------------------------------------------------------------*/ (defvar flyspell-changes nil) +(make-variable-buffer-local 'flyspell-changes) ;;*---------------------------------------------------------------------*/ ;;* flyspell-after-change-function ... */ ;;*---------------------------------------------------------------------*/ (defun flyspell-after-change-function (start stop len) "Save the current buffer and point for Flyspell's post-command hook." - (interactive) - (setq flyspell-changes (cons (cons start stop) flyspell-changes))) + (push (cons start stop) flyspell-changes)) ;;*---------------------------------------------------------------------*/ ;;* flyspell-check-changed-word-p ... */ @@ -899,7 +902,7 @@ Mostly we check word delimiters." (progn (setq flyspell-word-cache-end -1) (setq flyspell-word-cache-result '_))))) - (while (consp flyspell-changes) + (while (and (not (input-pending-p)) (consp flyspell-changes)) (let ((start (car (car flyspell-changes))) (stop (cdr (car flyspell-changes)))) (if (flyspell-check-changed-word-p start stop) @@ -1011,7 +1014,7 @@ Mostly we check word delimiters." ;; when emacs is exited without query (set-process-query-on-exit-flag ispell-process nil) ;; Wait until ispell has processed word. Since this code is often - ;; executed rom post-command-hook but the ispell process may not + ;; executed from post-command-hook but the ispell process may not ;; be responsive, it's important to make sure we re-enable C-g. (with-local-quit (while (progn diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index 0dcde3d69d5..bec088e2a1d 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 3.20 +;; Version: 3.21 ;; ;; This file is part of GNU Emacs. ;; @@ -76,10 +76,17 @@ ;; The documentation of Org-mode can be found in the TeXInfo file. The ;; distribution also contains a PDF version of it. At the homepage of ;; Org-mode, you can read the same text online as HTML. There is also an -;; excellent reference card made by Philip Rooke. +;; excellent reference card made by Philip Rooke. This card can be found +;; in the etc/ directory of Emacs 22. ;; ;; Changes: ;; ------- +;; Version 3.21 +;; - Improved CSS support for the HTML export. Thanks to Christian Egli. +;; - Editing support for hand-formatted lists +;; - M-S-cursor keys handle plain list items +;; - C-c C-c renumbers ordered plain lists +;; ;; Version 3.20 ;; - There is finally an option to make TAB jump over horizontal lines ;; in tables instead of creating a new line before that line. @@ -88,7 +95,7 @@ ;; - Changes to the HTML exporter ;; - hand-formatted lists are exported correctly, similar to ;; markdown lists. Nested lists are possible. See the docstring -;; of the variable `org-export-local-list-max-depth'. +;; of the variable `org-export-plain-list-max-depth'. ;; - cleaned up to produce valid HTML 4.0 (transitional). ;; - support for cascading style sheets. ;; - New command to cycle through all agenda files, on C-, @@ -234,7 +241,7 @@ ;;; Customization variables -(defvar org-version "3.20" +(defvar org-version "3.21" "The version number of the file org.el.") (defun org-version () (interactive) @@ -889,6 +896,25 @@ first line, so it is probably best to use this in combinations with :group 'org-structure :type 'boolean) +(defcustom org-plain-list-ordered-item-terminator t + "The character that makes a line with leading number an ordered list item. +Valid values are ?. and ?\). To get both terminators, use t. While +?. may look nicer, it creates the danger that a line with leading +number may be incorrectly interpreted as an item. ?\) therefore is +the safe choice." + :group 'org-structure + :type '(choice (const :tag "dot like in \"2.\"" ?.) + (const :tag "paren like in \"2)\"" ?\)) + (const :tab "both" t))) + +(defcustom org-auto-renumber-ordered-lists t + "Non-nil means, automatically renumber ordered plain lists. +Renumbering happens when the sequence have been changed with +\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands, +use \\[org-ctrl-c-ctrl-c] to trigger renumbering." + :group 'org-structure + :type 'boolean) + (defgroup org-link nil "Options concerning links in Org-mode." :tag "Org Link" @@ -1342,24 +1368,48 @@ This should have an association in `org-export-language-setup'." :group 'org-export :type 'string) -(defcustom org-export-html-style "" +(defcustom org-export-html-style +"<style type=\"text/css\"> + html { + font-family: Times, serif; + font-size: 12pt; + } + .title { text-align: center; } + .todo, .deadline { color: red; } + .done { color: green; } + pre { + border: 1pt solid #AEBDCC; + background-color: #F3F5F7; + padding: 5pt; + font-family: courier, monospace; + } + table { border-collapse: collapse; } + td, th { + vertical-align: top; + border: 1pt solid #ADB9CC; + } +</style>" "The default style specification for exported HTML files. Since there are different ways of setting style information, this variable needs to contain the full HTML structure to provide a style, including the -surrounding HTML tags. For example, legal values would be +surrounding HTML tags. The style specifications should include definiitons +for new classes todo, done, title, and deadline. For example, legal values +would be. <style type=\"text/css\"> p {font-weight: normal; color: gray; } h1 {color: black; } + .title { text-align: center; } + .todo, .deadline { color: red; } + .done { color: green; } </style> -or +or, if you want to keep the style in a file, <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> As the value of this option simply gets inserted into the HTML <head> header, -you can \"misuse\" it to add arbitrary text to the header. -" +you can \"misuse\" it to add arbitrary text to the header." :group 'org-export :type 'string) @@ -1393,18 +1443,16 @@ This option can also be set with the +OPTIONS line, e.g. \"toc:nil\"." :group 'org-export :type 'boolean) -(defcustom org-export-local-list-max-depth 1 +(defcustom org-export-plain-list-max-depth 3 "Maximum depth of hand-formatted lists in HTML export. + Org-mode parses hand-formatted enumeration and bullet lists and -transforms them to HTML open export. Different indentation of the bullet -or number indicates different list nesting levels. To avoid confusion, -only a single level is allowed by default. This means that a list is started -with an item, and that all further items are consitered as long as the -indentation is larger or equal to the indentation of the first item. When this -is larger than 1, deeper indentation leads to deeper list nesting. -If you are careful with hand formatting, you can increase this limit and -get lists of arbitrary depth. For example, by setting this option to 3, the -following list would look correct in HTML: +transforms them to HTML open export. Different indentation of the +bullet or number indicates different list nesting levels. To avoid +confusion, only a single level is allowed by default. When this is +larger than 1, deeper indentation leads to deeper list nesting. For +example, the default value of 3 allows the following list to be +formatted correctly in HTML: * Fruit - Apple @@ -2757,6 +2805,234 @@ If optional TXT is given, check this string instead of the current kill." (throw 'exit nil))) t)))) +;;; Plain list item + +(defun org-at-item-p () + "Is point in a line starting a hand-formatted item?" + (let ((llt org-plain-list-ordered-item-terminator)) + (save-excursion + (goto-char (point-at-bol)) + (looking-at + (cond + ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))))) + +(defun org-get-indentation () + "Get the indentation of the current line, ionterpreting tabs." + (save-excursion + (beginning-of-line 1) + (skip-chars-forward " \t") + (current-column))) + +(defun org-beginning-of-item () + "Go to the beginning of the current hand-formatted item. +If the cursor is not in an item, throw an error." + (let ((pos (point)) + (limit (save-excursion (org-back-to-heading) + (beginning-of-line 2) (point))) + ind ind1) + (if (org-at-item-p) + (beginning-of-line 1) + (beginning-of-line 1) + (skip-chars-forward " \t") + (setq ind (current-column)) + (if (catch 'exit + (while t + (beginning-of-line 0) + (if (< (point) limit) (throw 'exit nil)) + (unless (looking-at " \t]*$") + (skip-chars-forward " \t") + (setq ind1 (current-column)) + (if (< ind1 ind) + (throw 'exit (org-at-item-p)))))) + nil + (goto-char pos) + (error "Not in an item"))))) + +(defun org-end-of-item () + "Go to the beginning of the current hand-formatted item. +If the cursor is not in an item, throw an error." + (let ((pos (point)) + (limit (save-excursion (outline-next-heading) (point))) + (ind (save-excursion + (org-beginning-of-item) + (skip-chars-forward " \t") + (current-column))) + ind1) + (if (catch 'exit + (while t + (beginning-of-line 2) + (if (>= (point) limit) (throw 'exit t)) + (unless (looking-at "[ \t]*$") + (skip-chars-forward " \t") + (setq ind1 (current-column)) + (if (<= ind1 ind) (throw 'exit t))))) + (beginning-of-line 1) + (goto-char pos) + (error "Not in an item")))) + +(defun org-move-item-down (arg) + "Move the plain list item at point down, i.e. swap with following item. +Subitems (items with larger indentation are considered part of the item, +so this really moves item trees." + (interactive "p") + (let (beg end ind ind1 (pos (point)) txt) + (org-beginning-of-item) + (setq beg (point)) + (setq ind (org-get-indentation)) + (org-end-of-item) + (setq end (point)) + (setq ind1 (org-get-indentation)) + (if (and (org-at-item-p) (= ind ind1)) + (progn + (org-end-of-item) + (setq txt (buffer-substring beg end)) + (save-excursion + (delete-region beg end)) + (setq pos (point)) + (insert txt) + (goto-char pos) + (org-maybe-renumber-ordered-list)) + (goto-char pos) + (error "Cannot move this item further down")))) + +(defun org-move-item-up (arg) + "Move the plain list item at point up, i.e. swap with previous item. +Subitems (items with larger indentation are considered part of the item, +so this really moves item trees." + (interactive "p") + (let (beg end ind ind1 (pos (point)) txt) + (org-beginning-of-item) + (setq beg (point)) + (setq ind (org-get-indentation)) + (org-end-of-item) + (setq end (point)) + (goto-char beg) + (catch 'exit + (while t + (beginning-of-line 0) + (if (looking-at "[ \t]*$") + nil + (if (<= (setq ind1 (org-get-indentation)) ind) + (throw 'exit t))))) + (condition-case nil + (org-beginning-of-item) + (error (goto-char beg) + (error "Cannot move this item further up"))) + (setq ind1 (org-get-indentation)) + (if (and (org-at-item-p) (= ind ind1)) + (progn + (setq txt (buffer-substring beg end)) + (save-excursion + (delete-region beg end)) + (setq pos (point)) + (insert txt) + (goto-char pos) + (org-maybe-renumber-ordered-list)) + (goto-char pos) + (error "Cannot move this item further up")))) + +(defun org-maybe-renumber-ordered-list () + "Renumber the ordered list at point if setup allows it. +This tests the user option `org-auto-renumber-ordered-lists' before +doing the renumbering." + (and org-auto-renumber-ordered-lists + (org-at-item-p) + (match-beginning 3) + (org-renumber-ordered-list 1))) + +(defun org-get-string-indentation (s) + "What indentation has S due to SPACE and TAB at the beginning of the string?" + (let ((n -1) (i 0) (w tab-width) c) + (catch 'exit + (while (< (setq n (1+ n)) (length s)) + (setq c (aref s n)) + (cond ((= c ?\ ) (setq i (1+ i))) + ((= c ?\t) (setq i (* (/ (+ w i) w) w))) + (t (throw 'exit t))))) + i)) + +(defun org-renumber-ordered-list (arg) + "Renumber an ordered plain list. +Cursor neext to be in the first line of an item, the line that starts +with something like \"1.\" or \"2)\"." + (interactive "p") + (unless (and (org-at-item-p) + (match-beginning 3)) + (error "This is not an ordered list")) + (let ((line (org-current-line)) + (col (current-column)) + (ind (org-get-string-indentation + (buffer-substring (point-at-bol) (match-beginning 3)))) + (term (substring (match-string 3) -1)) + ind1 (n (1- arg))) + ;; find where this list begins + (catch 'exit + (while t + (catch 'next + (beginning-of-line 0) + (if (looking-at "[ \t]*$") (throw 'next t)) + (skip-chars-forward " \t") (setq ind1 (current-column)) + (if (and (<= ind1 ind) + (not (org-at-item-p))) + (throw 'exit t))))) + ;; Walk forward and replace these numbers + (catch 'exit + (while t + (catch 'next + (beginning-of-line 2) + (if (eobp) (throw 'exit nil)) + (if (looking-at "[ \t]*$") (throw 'next nil)) + (skip-chars-forward " \t") (setq ind1 (current-column)) + (if (> ind1 ind) (throw 'next t)) + (if (< ind1 ind) (throw 'exit t)) + (if (not (org-at-item-p)) (throw 'exit nil)) + (if (not (match-beginning 3)) + (error "unordered bullet in ordered list. Press \\[undo] to recover")) + (delete-region (match-beginning 3) (1- (match-end 3))) + (goto-char (match-beginning 3)) + (insert (format "%d" (setq n (1+ n))))))) + (goto-line line) + (move-to-column col))) + +(defvar org-last-indent-begin-marker (make-marker)) +(defvar org-last-indent-end-marker (make-marker)) + + +(defun org-outdent-item (arg) + "Outdent a local list item." + (interactive "p") + (org-indent-item (- arg))) + +(defun org-indent-item (arg) + "Indent a local list item." + (interactive "p") + (unless (org-at-item-p) + (error "Not on an item")) + (let (beg end ind ind1) + (if (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (setq beg org-last-indent-begin-marker + end org-last-indent-end-marker) + (org-beginning-of-item) + (setq beg (move-marker org-last-indent-begin-marker (point))) + (org-end-of-item) + (setq end (move-marker org-last-indent-end-marker (point)))) + (goto-char beg) + (skip-chars-forward " \t") (setq ind (current-column)) + (if (< (+ arg ind) 0) (error "Cannot outdent beyond margin")) + (while (< (point) end) + (beginning-of-line 1) + (skip-chars-forward " \t") (setq ind1 (current-column)) + (delete-region (point-at-bol) (point)) + (indent-to-column (+ ind1 arg)) + (beginning-of-line 2)) + (goto-char beg))) + + +;;; Archiving + (defun org-archive-subtree () "Move the current subtree to the archive. The archive can be a certain top-level heading in the current file, or in @@ -8985,6 +9261,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." (in-local-list nil) (local-list-num nil) (local-list-indent nil) + (llt org-plain-list-ordered-item-terminator) (email user-mail-address) (language org-export-default-language) (text nil) @@ -9039,7 +9316,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." " language (org-html-expand title) (or charset "iso-8859-1") date time author style)) - (if title (insert (concat "<H1 align=\"center\">" + (if title (insert (concat "<H1 class=\"title\">" (org-html-expand title) "</H1>\n"))) (if author (insert (concat (nth 1 lang-words) ": " author "\n"))) (if email (insert (concat "<a href=\"mailto:" email "\"><" @@ -9089,7 +9366,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." (insert (format (if todo - "<li><a href=\"#sec-%d\"><span style='color:red'>%s</span></a>\n" + "<li><a href=\"#sec-%d\"><span class=\"todo\">%s</span></a>\n" "<li><a href=\"#sec-%d\">%s</a>\n") head-count txt)) (setq org-last-level level)) @@ -9122,7 +9399,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." (insert "<pre>\n")) (insert (org-html-protect (match-string 1 line)) "\n") (when (and lines - (not (string-match "^[ \t]+\\(:.*\\)" + (not (string-match "^[ \t]*\\(:.*\\)" (car lines)))) (setq infixed nil) (insert "</pre>\n")) @@ -9180,9 +9457,9 @@ headlines. The default is 3. Lower levels will become bulleted lists." (match-beginning 2)) (if (equal (match-string 2 line) org-done-string) (setq line (replace-match - "<span style='color:green'>\\2</span>" + "<span class=\"done\">\\2</span>" nil nil line 2)) - (setq line (replace-match "<span style='color:red'>\\2</span>" + (setq line (replace-match "<span class=\"todo\">\\2</span>" nil nil line 2)))) ;; DEADLINES @@ -9192,9 +9469,8 @@ headlines. The default is 3. Lower levels will become bulleted lists." (string-match "<a href" (substring line 0 (match-beginning 0)))) nil ; Don't do the replacement - it is inside a link - (setq line (replace-match "<span style='color:red'>\\&</span>" + (setq line (replace-match "<span class=\"deadline\">\\&</span>" nil nil line 1))))) - (cond ((string-match "^\\(\\*+\\)[ \t]*\\(.*\\)" line) ;; This is a headline @@ -9233,13 +9509,21 @@ headlines. The default is 3. Lower levels will become bulleted lists." (insert (org-format-table-html table-buffer table-orig-buffer)))) (t ;; Normal lines - (when (and (> org-export-local-list-max-depth 0) + (when (and (> org-export-plain-list-max-depth 0) (string-match - "^\\( *\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\)\\)? *\\([^ \t\n\r]\\)" + (cond + ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+[.)]\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") + ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+\\.\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") + ((= llt ?\)) "^\\( \t]*\\)\\(\\([-+*]\\)\\|\\([0-9]+)\\)\\)?\\( +[^ \t\n\r]\\|[ \t]*$\\)") + (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) line)) - (setq ind (- (match-end 1) (match-beginning 1)) + (setq ind (org-get-string-indentation line) start-is-num (match-beginning 4) - starter (if (match-beginning 2) (match-string 2 line))) + starter (if (match-beginning 2) (match-string 2 line)) + line (substring line (match-beginning 5))) + (unless (string-match "[^ \t]" line) + ;; empty line. Pretend indentation is large. + (setq ind (1+ (or (car local-list-indent) 1)))) (while (and in-local-list (or (and (= ind (car local-list-indent)) (not starter)) @@ -9247,13 +9531,12 @@ headlines. The default is 3. Lower levels will become bulleted lists." (insert (if (car local-list-num) "</ol>\n" "</ul>")) (pop local-list-num) (pop local-list-indent) (setq in-local-list local-list-indent)) - (cond ((and starter (or (not in-local-list) (> ind (car local-list-indent))) (< (length local-list-indent) - org-export-local-list-max-depth)) + org-export-plain-list-max-depth)) ;; Start new (level of ) list (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n")) (push start-is-num local-list-num) @@ -9261,8 +9544,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." (setq in-local-list t)) (starter ;; continue current list - (insert "<li>\n"))) - (setq line (substring line (match-beginning 5)))) + (insert "<li>\n")))) ;; Empty lines start a new paragraph. If hand-formatted lists ;; are not fully interpreted, lines starting with "-", "+", "*" ;; also start a new paragraph. @@ -9327,7 +9609,7 @@ headlines. The default is 3. Lower levels will become bulleted lists." (mapconcat (lambda (x) (if head (concat "<th>" x "</th>") - (concat "<td valign=\"top\">" x "</td>"))) + (concat "<td>" x "</td>"))) fields "") "</tr>\n")))) (setq html (concat html "</table>\n")) @@ -9366,10 +9648,8 @@ But it has the disadvantage, that no cell- or row-spanning is allowed." (lambda (x) (if (equal x "") (setq x empty)) (if head - (concat "<th valign=\"top\">" x - "</th>\n") - (concat "<td valign=\"top\">" x - "</td>\n"))) + (concat "<th>" x "</th>\n") + (concat "<td>" x "</td>\n"))) field-buffer "\n") "</tr>\n")) (setq head nil) @@ -10016,6 +10296,7 @@ See the individual commands for more information." (cond ((org-at-table-p) (org-table-delete-column)) ((org-on-heading-p) (org-promote-subtree)) + ((org-at-item-p) (call-interactively 'org-outdent-item)) (t (org-shiftcursor-error)))) (defun org-shiftmetaright () @@ -10026,30 +10307,36 @@ See the individual commands for more information." (cond ((org-at-table-p) (org-table-insert-column)) ((org-on-heading-p) (org-demote-subtree)) + ((org-at-item-p) (call-interactively 'org-indent-item)) (t (org-shiftcursor-error)))) (defun org-shiftmetaup (&optional arg) "Move subtree up or kill table row. -Calls `org-move-subtree-up' or `org-table-kill-row', depending on context. -See the individual commands for more information." +Calls `org-move-subtree-up' or `org-table-kill-row' or +`org-move-item-up' depending on context. See the individual commands +for more information." (interactive "P") (cond ((org-at-table-p) (org-table-kill-row)) ((org-on-heading-p) (org-move-subtree-up arg)) + ((org-at-item-p) (org-move-item-up arg)) (t (org-shiftcursor-error)))) (defun org-shiftmetadown (&optional arg) "Move subtree down or insert table row. -Calls `org-move-subtree-down' or `org-table-insert-row', depending on context. -See the individual commands for more information." +Calls `org-move-subtree-down' or `org-table-insert-row' or +`org-move-item-down', depending on context. See the individual +commands for more information." (interactive "P") (cond ((org-at-table-p) (org-table-insert-row arg)) ((org-on-heading-p) (org-move-subtree-down arg)) + ((org-at-item-p) (org-move-item-down arg)) (t (org-shiftcursor-error)))) (defun org-metaleft (&optional arg) "Promote heading or move table column to left. Calls `org-do-promote' or `org-table-move-column', depending on context. +With no specific context, calls the Emacs default `backward-word'. See the individual commands for more information." (interactive "P") (cond @@ -10060,6 +10347,7 @@ See the individual commands for more information." (defun org-metaright (&optional arg) "Demote subtree or move table column to right. Calls `org-do-demote' or `org-table-move-column', depending on context. +With no specific context, calls the Emacs default `forward-word'. See the individual commands for more information." (interactive "P") (cond @@ -10069,22 +10357,26 @@ See the individual commands for more information." (defun org-metaup (&optional arg) "Move subtree up or move table row up. -Calls `org-move-subtree-up' or `org-table-move-row', depending on context. -See the individual commands for more information." +Calls `org-move-subtree-up' or `org-table-move-row' or +`org-move-item-up', depending on context. See the individual commands +for more information." (interactive "P") (cond ((org-at-table-p) (org-table-move-row 'up)) ((org-on-heading-p) (org-move-subtree-up arg)) + ((org-at-item-p) (org-move-item-up arg)) (t (org-shiftcursor-error)))) (defun org-metadown (&optional arg) "Move subtree down or move table row down. -Calls `org-move-subtree-down' or `org-table-move-row', depending on context. -See the individual commands for more information." +Calls `org-move-subtree-down' or `org-table-move-row' or +`org-move-item-down', depending on context. See the individual +commands for more information." (interactive "P") (cond ((org-at-table-p) (org-table-move-row nil)) ((org-on-heading-p) (org-move-subtree-down arg)) + ((org-at-item-p) (org-move-item-down arg)) (t (org-shiftcursor-error)))) (defun org-shiftup (&optional arg) @@ -10153,6 +10445,8 @@ If the cursor is on a #+TBLFM line, re-apply the formulae to the table." (org-table-recalculate t) (org-table-maybe-recalculate-line)) (org-table-align)) + ((org-at-item-p) + (org-renumber-ordered-list (prefix-numeric-value arg))) ((save-excursion (beginning-of-line 1) (looking-at "#\\+\\([A-Z]+\\)")) (cond ((equal (match-string 1) "TBLFM") @@ -10165,11 +10459,13 @@ If the cursor is on a #+TBLFM line, re-apply the formulae to the table." (org-mode-restart)))) ((org-region-active-p) (org-table-convert-region (region-beginning) (region-end) arg)) - ((and (region-beginning) (region-end)) + ((condition-case nil + (and (region-beginning) (region-end)) + (error nil)) (if (y-or-n-p "Convert inactive region to table? ") (org-table-convert-region (region-beginning) (region-end) arg) (error "Abort"))) - (t (error "No table at point, and no region to make one"))))) + (t (error "C-c C-c can do nothing useful at this location."))))) (defun org-mode-restart () "Restart Org-mode, to scan again for special lines. @@ -10436,7 +10732,7 @@ With optional NODE, go directly to that node." (set (make-local-variable 'paragraph-separate) "\f\\|\\*\\|[ ]*$\\|[ \t]*[:|]") ;; The paragraph starter includes hand-formatted lists. (set (make-local-variable 'paragraph-start) - "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*]\\|[0-9]+\\.[ \t]+\\)\\|[ \t]*[:|]") + "\f\\|[ ]*$\\|\\([*\f]+\\)\\|[ \t]*\\([-+*]\\|[0-9]+[.)][ \t]+\\)\\|[ \t]*[:|]") ;; Inhibit auto-fill for headers, tables and fixed-width lines. ;; But only if the user has not turned off tables or fixed-width regions (set (make-local-variable 'auto-fill-inhibit-regexp) @@ -10472,7 +10768,7 @@ With optional NODE, go directly to that node." "Return a fill prefix for org-mode files. In particular, this makes sure hanging paragraphs for hand-formatted lists work correctly." - (if (looking-at " *\\([-*+] \\|[0-9]+\\. \\)?") + (if (looking-at " *\\([-*+] \\|[0-9]+[.)] \\)?") (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) ;; Functions needed for Emacs/XEmacs region compatibility @@ -10707,3 +11003,4 @@ Show the heading too, if it is currently invisible." ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here + diff --git a/lisp/view.el b/lisp/view.el index 0d6b941a0ca..4cbc0fe9e4c 100644 --- a/lisp/view.el +++ b/lisp/view.el @@ -93,6 +93,12 @@ considered for restoring." :type 'boolean :group 'view) +(defcustom view-inhibit-help-message nil + "*Non-nil inhibits the help message showed upon entering View mode." + :type 'boolean + :group 'view + :version "22.1") + ;;;###autoload (defvar view-mode nil "Non-nil if View mode is enabled. @@ -516,9 +522,10 @@ This function runs the normal hook `view-mode-hook'." (unless view-mode ; Do nothing if already in view mode. (view-mode-enable) (force-mode-line-update) - (message "%s" - (substitute-command-keys "\ -View mode: type \\[help-command] for help, \\[describe-mode] for commands, \\[View-quit] to quit.")))) + (unless view-inhibit-help-message + (message "%s" + (substitute-command-keys "\ +View mode: type \\[help-command] for help, \\[describe-mode] for commands, \\[View-quit] to quit."))))) (defun view-mode-exit (&optional return-to-alist exit-action all-win) "Exit View mode in various ways, depending on optional arguments. diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el index c3eb9519ab1..1268994ba89 100644 --- a/lisp/xt-mouse.el +++ b/lisp/xt-mouse.el @@ -151,10 +151,12 @@ (set-terminal-parameter nil 'xterm-mouse-x x) (set-terminal-parameter nil 'xterm-mouse-y y) - (if w - (list mouse (posn-at-x-y (- x left) (- y top) w t)) - (list mouse - (append (list nil 'menu-bar) (nthcdr 2 (posn-at-x-y x y w t))))))) + (setq + last-input-event + (if w + (list mouse (posn-at-x-y (- x left) (- y top) w t)) + (list mouse + (append (list nil 'menu-bar) (nthcdr 2 (posn-at-x-y x y w t)))))))) ;;;###autoload (define-minor-mode xterm-mouse-mode |