diff options
| author | Stefan Monnier <[email protected]> | 2011-02-11 21:27:53 -0500 |
|---|---|---|
| committer | Stefan Monnier <[email protected]> | 2011-02-11 21:27:53 -0500 |
| commit | c530e1c2a3a036d71942c354ba11b30a06341fd7 (patch) | |
| tree | 184fa6b6c9bb58855aa9f1ae6cded97edc4f10fb /lisp | |
| parent | 295fb2ac59b66c0e2470325a42c8e58c135ed044 (diff) | |
| parent | e0e36cac4adaa32ad755a34c811366dd8e4655bc (diff) | |
Merge from trunk
Diffstat (limited to 'lisp')
116 files changed, 4719 insertions, 4344 deletions
diff --git a/lisp/ChangeLog.trunk b/lisp/ChangeLog.trunk index 584bf71c74..b3735e3728 100644 --- a/lisp/ChangeLog.trunk +++ b/lisp/ChangeLog.trunk @@ -1,3 +1,422 @@ +2011-02-11 Deniz Dogan <[email protected]> + + * net/rcirc.el (defun-rcirc-join): Accept multiple channels. + +2011-02-11 Glenn Morris <[email protected]> + + * emacs-lisp/cl-specs.el (multiple-value-bind): Fix debug spec. + +2011-02-11 Juanma Barranquero <[email protected]> + + * net/rcirc.el (rcirc-send-ctcp): Remove spurious arg to `format'. + +2011-02-10 Stefan Monnier <[email protected]> + + * server.el (server-process-filter): Use pcase. + + * emacs-lisp/smie.el (smie-blink-matching-open): Don't use `pos' in two + conflicting ways. + (smie-indent--parent): Extend to "parent of arg". + (smie-indent-inside-string): New function. + (smie-indent-functions): Use it. + + * vc/vc-dir.el (vc-dir-refresh): Reorder operations to try and avoid + bzr locking race condition. + + * emacs-lisp/edebug.el (edebug-instrument-function): Check a marker is + still valid before using it. + + * progmodes/grep.el (grep-mode-font-lock-keywords): Adjust to + `message' -> `compilation-message' rename (bug#8004). + + Move keymap initialization into declaration. + * textmodes/enriched.el (enriched-mode-map): + * textmodes/bib-mode.el (bib-mode-map): + * term/lk201.el (lk201-function-map): + * tar-mode.el (tar-mode-map): + * replace.el (occur-mode-map): + * progmodes/idlwave.el (idlwave-rinfo-mouse-map, idlwave-rinfo-map): + * progmodes/idlw-help.el (idlwave-help-mode-map): + * progmodes/gdb-mi.el (gdb-memory-format-menu, gdb-memory-unit-menu): + * play/solitaire.el (solitaire-mode-map): + * play/snake.el (snake-mode-map, snake-null-map): + * play/pong.el (pong-mode-map): + * play/handwrite.el (menu-bar-handwrite-map): + * play/gametree.el (gametree-mode-map): + * net/rcirc.el (rcirc-mode-map, rcirc-browse-url-map + (rcirc-multiline-minor-mode-map, rcirc-track-minor-mode-map): + * net/newst-plainview.el (newsticker-menu, newsticker-mode-map) + (newsticker--url-keymap): + * net/net-utils.el (nslookup-mode-map, ftp-mode-map): + * menu-bar.el (menu-bar-file-menu, menu-bar-i-search-menu) + (menu-bar-search-menu, menu-bar-replace-menu, menu-bar-goto-menu) + (menu-bar-edit-menu, menu-bar-custom-menu) + (menu-bar-showhide-fringe-ind-menu, menu-bar-showhide-fringe-menu) + (menu-bar-showhide-scroll-bar-menu, menu-bar-showhide-menu) + (menu-bar-line-wrapping-menu, menu-bar-options-menu) + (menu-bar-games-menu, menu-bar-encryption-decryption-menu) + (menu-bar-tools-menu, menu-bar-describe-menu) + (menu-bar-search-documentation-menu, menu-bar-manuals-menu) + (menu-bar-help-menu): + * mail/rmailsum.el (rmail-summary-mode-map): + * kmacro.el (kmacro-step-edit-map): + * ibuffer.el (ibuffer-mode-groups-popup, ibuffer-mode-map) + (ibuffer-mode-operate-map): + * hi-lock.el (hi-lock-menu, hi-lock-map): + * emulation/vip.el (vip-mode-map): + * emacs-lisp/re-builder.el (reb-lisp-mode-map): + * bookmark.el (bookmark-bmenu-mode-map): + * help-mode.el (help-mode-map): Move initialization into declaration. + +2011-02-10 Deniz Dogan <[email protected]> + + * net/rcirc.el: Add PRIVMSG and CTCP functions. + (rcirc-send-privmsg, rcirc-send-ctcp): New functions. + (rcirc-keepalive, rcirc-cmd-ctcp, rcirc-ctcp-sender-PING) + (rcirc-cmd-me, rcirc-authenticate): Use them. + +2011-02-10 Ken Manheimer <[email protected]> + + * allout.el: Synopsis: Change allout user configuration so + auto-activation is controlled solely by customization + `allout-auto-activation'. + + (allout-auto-activation-helper) (allout-setup): New autoloads + implement new custom set procedure for allout-auto-activation. + Also, explicitly invoke + (allout-setup) after allout-auto-activation is custom-defined, to + effect the settings in emacs sessions besides the few where + allout-auto-activation customization is donea. + (allout-auto-activation): Use allout-auto-activation-helper to + :set. Revise the docstring. + (allout-init): Reduce functionality to just customizing + allout-auto-activation, and mark obsolete. + (allout-mode): Respect string values for allout-auto-activation. + Run allout-after-copy-or-kill-hook without any args. + (allout-mode) (allout-layout) (allout-default-layout) + (outlineify-sticky): Adjust docstring for new scheme. + (allout-after-copy-or-kill-hook): No arguments - hook implementers + should concentrate on the kill ring. + +2011-02-09 Stefan Monnier <[email protected]> + + * progmodes/sh-script.el (sh-font-lock-open-heredoc): Fix case + of here-doc that immediately follows a comment. + +2011-02-09 Deniz Dogan <[email protected]> + + * net/rcirc.el (rcirc-ctcp-sender-PING): Simplifying. + + * net/rcirc.el (rcirc-cmd-ctcp): Use dedicated function when + available. + (rcirc-ctcp-sender-PING): New function. + +2011-02-08 Stefan Monnier <[email protected]> + + * obsolete/pc-select.el: Rename from emulation/pc-select.el (bug#7940). + Remove the mark/nomark handling, and activate shift-select-mode instead. + + * obsolete/pc-mode.el: Rename from emulation/pc-mode.el. + +2011-02-07 Jay Belanger <[email protected]> + + * calc/calc-units.el (math-logunits-quant): Add support for + non-logarithmic units. + +2011-02-07 Ken Manheimer <[email protected]> + + * allout.el (allout-after-copy-or-kill-hook): New hook for + extension-specific processing of killed text. + (allout-mode): Include new allout-after-copy-or-kill-hook among + mentioned hooks. + (allout-kill-line) (allout-kill-topic): Ensure that processing + after kill happens even if barf-if-buffer-read-only is raised. + Include new allout-after-copy-or-kill-hook among that subsequent + processing. + (allout-deannotate-hidden): Actually remove the annotation text + properties. + + * allout.el (allout-listify-exposed): Copy text sans text properties. + +2011-02-07 Michael Albinus <[email protected]> + + * net/dbus.el (dbus-list-activatable-names): Add optional argument BUS. + +2011-02-07 Deniz Dogan <[email protected]> + + * net/rcirc.el (rcirc-handler-317): New function (Bug#6507). + +2011-02-06 Jay Belanger <[email protected]> + + * calc/calc.el (calc-logunits-field-reference): Rename from + `calc-default-field-reference-level'. + (calc-logunits-power-reference): Rename from + `calc-default-power-reference-level' + + * calc/calc-units.el (math-logunits-quant): Rename from + `math-logunits-level' + (math-logunits-plus): Rename from math-logcombine. + (calcFunc-luplus, calcFunc-luminus calc-luplus, calc-luminus): Remove. + (calcFunc-lufieldadd, calcFunc-lupoweradd, calcFunc-lufieldsub) + (calcFunc-lufieldsub,calc-logunits-add calc-logunits-sub): + New functions. + (calcFunc-fieldquant): Rename from `calcFunc-fieldlevel'. + (calcFunc-powerquant): Rename from `calcFunc-powerlevel'. + (calc-logunits-quantity): Rename from `calc-level'. + (calcFunc-dbfieldlevel, calcFunc-dbpowerlevel, calcFunc-npfieldlevel) + (calcFunc-nppowerlevel,calc-logunits-dblevel, calc-logunits-nplevel) + (math-logunits-mul, calcFunc-lufieldmul, calcFunc-lupowermul) + (calc-logunits-mul, math-logunits-divide, calcFunc-lufielddiv) + (calcFunc-lupowerdiv,calc-logunits-divide,math-logunits-level): + New functions. + + * calc/calc-help.el (calc-u-prefix-help): Remove "L" reference. + (calc-ul-prefix-help): Remove. + (calc-l-prefix-help): New function. + (calc-full-help): Add reference to `calc-l-prefix-help'. + + * calc/calc-ext.el (calc-init-extensions): Update autoloads. + + * calc/README: Mention logarithmic units. + +2011-02-06 Chong Yidong <[email protected]> + + * mail/emacsbug.el (report-emacs-bug-hook): Remove the check for + non-ASCII characters (Bug#7925). + +2011-02-05 Glenn Morris <[email protected]> + + * emacs-lisp/cl-macs.el (return-from): Fix doc typo. + + * calendar/diary-lib.el (diary-font-lock-keywords): + Tweak diary-time-regexp match. (Bug#7891) + + * progmodes/f90.el (f90-find-tag-default): New function. (Bug#7919) + (f90-mode): Use it for mode's `find-tag-default-function' property. + + * ibuf-ext.el (ibuffer-filter-disable): Make it work. (Bug#7969) + + * faces.el (set-face-attribute): Doc fix. (Bug#2659) + +2011-02-05 Deniz Dogan <[email protected]> + + * net/rcirc.el (rcirc-handler-JOIN): Reset mode-line-process + (Bug#6386). + +2011-02-05 Stefan Monnier <[email protected]> + + * progmodes/sh-script.el (sh-here-doc-open-re): Don't rely on the + font-lock-syntax-table remappings. + (sh-here-doc-markers, sh-here-doc-re): Remove. + (sh-font-lock-close-heredoc): Remove. + (sh-syntax-propertize-here-doc): New function. + (sh-font-lock-open-heredoc): Set the sh-here-doc-marker property + instead of the sh-here-doc-re. + (sh-font-lock-paren): Don't do anything in comments or strings. + Handle line continuations. Accept a few more chars. + Don't rely on the font-lock-syntax-table remappings. + `esac' is not a valid pattern. + (sh-syntax-propertize-function): Handle here-docs differently, so we + don't bother syntax-propertizing the insides. + + * progmodes/sh-script.el (sh-font-lock-paren, sh-kw, sh-prev-thing): + Handle new bashisms ";&" and ";;&" (bug#7947). + +2011-02-05 Michael Albinus <[email protected]> + + * net/tramp-smb.el (tramp-smb-errors): Use `regexp-opt'. + Add "NT_STATUS_IO_TIMEOUT" and "NT_STATUS_NO_SUCH_USER". + +2011-02-05 Era Eriksson <[email protected]> (tiny change) + + * net/tramp.el (tramp-postfix-method-format) + (tramp-postfix-method-regexp, tramp-prefix-domain-format) + (tramp-prefix-domain-regexp, tramp-postfix-user-format) + (tramp-postfix-user-regexp, tramp-prefix-port-format) + (tramp-prefix-port-regexp, tramp-postfix-host-format) + (tramp-postfix-host-regexp, tramp-handle-substitute-in-file-name): + Doc fix. + +2011-02-04 Sam Steingold <[email protected]> + + * mouse.el (mouse-buffer-menu-mode-groups): Add a "GDB" group. + +2011-02-04 Andreas Schwab <[email protected]> + + * international/mule-util.el (with-coding-priority): Doc fix. + +2011-02-04 Eli Zaretskii <[email protected]> + + * arc-mode.el (archive-mode-map): Fix a typo in last change. + +2011-02-03 Sam Steingold <[email protected]> + + * progmodes/gdb-mi.el (gdb-breakpoints-list-handler-custom): + Do not error out when `func' is nil. + +2011-02-03 Michael Albinus <[email protected]> + + * net/tramp-sh.el (tramp-remote-path): Add default settings for + `tramp-default-remote-path' to the docstring. + (tramp-get-remote-path): Suppress error message when `getconf + PATH' fails. + + * net/tramp-smb.el (tramp-smb-errors): Add "NT_STATUS_UNSUCCESSFUL". + +2011-02-03 Glenn Morris <[email protected]> + + * vc/vc-hg.el (vc-hg-command): Doc fix. + + * term/w32-win.el (libpng-version): Declare for compiler. + + * msb.el: No need to load dired while compiling. + + * emacs-lisp/elint.el (elint-standard-variables): + Remove a couple of built-ins that now have doc-strings. + + * hi-lock.el, ps-bdf.el, ps-mule.el, ps-print.el, ps-samp.el: + `require' is automatically `eval-and-compile'd. + + * net/rcirc.el (rcirc-nick-completion-format): Add :version tag. + (rcirc-log-directory, rcirc-log-flag): Move definitions before use. + + * strokes.el (strokes-fill-current-buffer-with-whitespace): + Move definition before use. + (strokes-report-bug): Make it obsolete. + +2011-02-02 Sam Steingold <[email protected]> + + * apropos.el (apropos-print): Now that `apropos-mode' inherits + from `special-mode', entering it makes the buffer read-only, so + call it only when everything has been already inserted. + * emacs-lisp/ert.el (ert--setup-results-buffer) + (ert-results-pop-to-backtrace-for-test-at-point) + (ert-results-pop-to-messages-for-test-at-point) + (ert-results-pop-to-timings): Ditto. + * emacs-lisp/package.el (package--list-packages): Ditto. + * play/solitaire.el (solitaire): Ditto. + +2011-02-02 Chong Yidong <[email protected]> + + * progmodes/compile.el: Make all faces inherit. + (compilation-warning): Inherit from font-lock-variable-name-face. + (compilation-info): Inherit from font-lock-type-face. + (compilation-line-number): Reassign to font-lock-keyword-face. + (compilation-column-number): Reassign to font-lock-doc-face. + (compilation-leave-directory-face): Reassign to + font-lock-builtin-face. + +2011-02-02 Eli Zaretskii <[email protected]> + + * dired.el (dired-insert-directory): Don't invoke `ls' when + ls-lisp.el is used to emulate it. + +2011-02-01 Julien Danjou <[email protected]> + + * color.el (color-gradient): Add a color-gradient function. + +2011-02-01 Sam Steingold <[email protected]> + + * simple.el (special-mode-map): Bind "h" to `describe-mode'; + bind "z" to `kill-this-buffer'. + (completion-list-mode-map): Bind "z" to `kill-this-buffer'. + * apropos.el (apropos-mode-map): Inherit from `special-mode-map'. + (apropos-mode): Inherit from `special-mode'. + * arc-mode.el (archive-mode-map): Inherit from `special-mode-map'. + * bookmark.el (bookmark-bmenu-mode): Define using + `define-derived-mode' inheriting from `special-mode'. + * dired.el (dired-mode-map): Inherit from `special-mode-map'. + * image-mode.el (image-mode-map): Ditto. + * replace.el (occur-mode): Define using + `define-derived-mode' inheriting from `special-mode'. + * tar-mode.el (tar-mode): Inherit from `special-mode'. + * calendar/diary-lib.el (diary-fancy-display-mode): + Inherit from `special-mode-map'. + * emacs-lisp/ert.el (ert-simple-view-mode, ert-results-mode): + Inherit from `special-mode'. + * emacs-lisp/package.el (package-menu-mode-map): Copy from + `special-mode-map'. + (package-menu-mode): Define using `define-derived-mode' + inheriting from `special-mode'. + * erc/erc-list.el (erc-list-menu-mode): Inherit from `special-mode'. + * net/xesam.el (xesam-mode): Inherit from `special-mode'. + (xesam-mode-map): Define separately. + * play/solitaire.el (solitaire-mode): Inherit from `special-mode'. + * progmodes/compile.el (compilation-minor-mode-map) + (compilation-mode-map): Inherit from `special-mode-map'. + * vc/diff-mode.el (diff-mode-shared-map): + Inherit from `special-mode-map'. + * vc/log-view.el (log-view-mode-map): Add a comment. + +2011-02-01 Chong Yidong <[email protected]> + + * custom.el (load-theme): Define return value. Drop use of + unsafep; call custom-theme-load-confirm for non-known-safe themes. + (custom-theme-load-confirm): Scroll in the correct window. + (custom-enabled-themes): Add custom-safe-themes to :set-after. + + * cus-theme.el (custom-theme-checkbox-toggle): Don't activate the + checkbox if load-theme fails. + +2011-02-01 Stefan Monnier <[email protected]> + + * progmodes/compile.el (compilation-next-error): Check there's + a message before using it (bug#7941). + +2011-02-01 Jay Belanger <[email protected]> + + * calc/calc-mtx.el (math-lud-pivot-check): New function. + (math-do-matrix-lud): Use `math-lud-pivot-check' to check the size + of potential pivots. + +2011-01-31 Alan Mackenzie <[email protected]> + + * progmodes/cc-cmds.el (c-forward-over-illiterals): + Continue parsing if we encounter a naked # (Bug#7595). + (c-beginning-of-statement): Avoid loop in locating the beginning + of a macro. + +2011-01-31 Chong Yidong <[email protected]> + + * files.el (copy-directory): Fix arguments to recursive call. + +2011-01-31 Chong Yidong <[email protected]> + + * files.el (copy-directory): If destination is an existing + directory, copy into a subdirectory there. + +2011-01-31 Andreas Schwab <[email protected]> + + * emacs-lisp/shadow.el (load-path-shadows-find): Ignore leim-list + files. + +2011-01-31 Chong Yidong <[email protected]> + + * image-dired.el (image-dired-mouse-display-image): No-op if no + file is found (Bug#7817). + + * mouse.el (mouse-menu-non-singleton): Doc fix (Bug#7801). + +2011-01-31 Kenichi Handa <[email protected]> + + * international/quail.el (quail-keyboard-layout-alist): + Remove superfluous SPC for "pc105-uk" (bug#7927). + +2011-01-31 Glenn Morris <[email protected]> + + * msb.el (msb-menu-bar-update-buffers): Update for changed + argument handling of menu-bar-select-frame. (Bug#7902) + +2011-01-31 Chong Yidong <[email protected]> + + * progmodes/cc-engine.el (c-forward-<>-arglist-recur): Set a limit + to the recursion depth (Bug#7722). + +2011-01-31 Roy Liu <[email protected]> (tiny change) + + * term/ns-win.el (ns-find-file): Expand ns-input-file with + command-line-default-directory (Bug#7872). + 2011-01-31 Stefan Monnier <[email protected]> * progmodes/compile.el (compilation--flush-directory-cache): @@ -17,6 +436,12 @@ 2011-01-31 Deniz Dogan <[email protected]> + * net/rcirc.el: New customizable nick completion format. (Bug#6314) + (rcirc-nick-completion-format): New defcustom. + (rcirc-complete): Use it. + +2011-01-31 Deniz Dogan <[email protected]> + * net/rcirc.el: Clean log filenames (Bug#7933). (rcirc-log-write): Use convert-standard-filename. (rcirc-log-filename-function): Documentation updates. diff --git a/lisp/allout.el b/lisp/allout.el index d965ac3533..5d87415a57 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -62,18 +62,15 @@ ;; The latest development version and helpful notes are available at ;; http://myriadicity.net/Sundry/EmacsAllout . ;; -;; The outline menubar additions provide quick reference to many of -;; the features, and see the docstring of the variable `allout-init' -;; for instructions on priming your Emacs session for automatic -;; activation of allout-mode. -;; -;; See the docstring of the variables `allout-layout' and +;; The outline menubar additions provide quick reference to many of the +;; features. See the docstring of the variables `allout-layout' and ;; `allout-auto-activation' for details on automatic activation of -;; `allout-mode' as a minor mode. (It has changed since allout -;; 3.x, for those of you that depend on the old method.) +;; `allout-mode' as a minor mode. (`allout-init' is deprecated in favor of +;; a purely customization-based method.) ;; ;; Note -- the lines beginning with `;;;_' are outline topic headers. -;; Just `ESC-x eval-buffer' to give it a whirl. +;; Customize `allout-auto-activation' to enable, then revisit this +;; buffer to give it a whirl. ;; ken manheimer (ken dot manheimer at gmail dot com) @@ -271,35 +268,56 @@ See the existing keys for examples." :set 'allout-compose-and-institute-keymap ) +;;;_ > allout-auto-activation-helper (var value) +;;;###autoload +(defun allout-auto-activation-helper (var value) + "Institute `allout-auto-activation'. + +Intended to be used as the `allout-auto-activation' :set function." + (set-default var value) + (allout-setup)) +;;;_ > allout-setup () +;;;###autoload +(defun allout-setup () + "Do fundamental emacs session for allout auto-activation. + +Establishes allout processing as part of visiting a file if +`allout-auto-activation' is non-nil, or removes it otherwise. + +The proper way to use this is through customizing the setting of +`allout-auto-activation'." + (if (not allout-auto-activation) + (remove-hook 'find-file-hook 'allout-find-file-hook) + (add-hook 'find-file-hook 'allout-find-file-hook))) ;;;_ = allout-auto-activation +;;;###autoload (defcustom allout-auto-activation nil - "Regulates auto-activation modality of allout outlines -- see `allout-init'. + "Configure allout outline mode auto-activation. -Setq-default by `allout-init' to regulate whether or not allout -outline mode is automatically activated when the buffer-specific -variable `allout-layout' is non-nil, and whether or not the layout -dictated by `allout-layout' should be imposed on mode activation. +Control whether and how allout outline mode is automatically +activated when files are visited with non-nil buffer-specific +file variable `allout-layout'. -With value t, auto-mode-activation and auto-layout are enabled. -\(This also depends on `allout-find-file-hook' being installed in -`find-file-hook', which is also done by `allout-init'.) +When allout-auto-activation is \"On\" \(t), allout mode is +activated in buffers with non-nil `allout-layout', and the +specified layout is applied. -With value `ask', auto-mode-activation is enabled, and endorsement for +With value \"ask\", auto-mode-activation is enabled, and endorsement for performing auto-layout is asked of the user each time. -With value `activate', only auto-mode-activation is enabled, -auto-layout is not. +With value \"activate\", only auto-mode-activation is enabled. +Auto-layout is not. With value nil, neither auto-mode-activation nor auto-layout are -enabled. - -See the docstring for `allout-init' for the proper interface to -this variable." +enabled, and allout auto-activation processing is removed from +file visiting activities." + :set 'allout-auto-activation-helper :type '(choice (const :tag "On" t) (const :tag "Ask about layout" "ask") (const :tag "Mode only" "activate") (const :tag "Off" nil)) :group 'allout) +(allout-setup) ;;;_ = allout-default-layout (defcustom allout-default-layout '(-2 : 0) "Default allout outline layout specification. @@ -311,7 +329,7 @@ layout specifications. A list value specifies a default layout for the current buffer, to be applied upon activation of `allout-mode'. Any non-nil value will automatically trigger `allout-mode', provided -`allout-init' has been called to enable this behavior. +`allout-auto-activation' has been customized to enable it. The types of elements in the layout specification are: @@ -890,10 +908,10 @@ For details, see `allout-toggle-current-subtree-encryption's docstring." (defvar allout-layout nil ; LEAVE GLOBAL VALUE NIL -- see docstring. "Buffer-specific setting for allout layout. -In buffers where this is non-nil (and if `allout-init' has been run, to -enable this behavior), `allout-mode' will be automatically activated. The -layout dictated by the value will be used to set the initial exposure when -`allout-mode' is activated. +In buffers where this is non-nil \(and if `allout-auto-activation' +has been customized to enable this behavior), `allout-mode' will be +automatically activated. The layout dictated by the value will be used to +set the initial exposure when `allout-mode' is activated. \*You should not setq-default this variable non-nil unless you want every visited file to be treated as an allout file.* @@ -906,9 +924,9 @@ example, the following lines at the bottom of an Emacs Lisp file: ;;;End: dictate activation of `allout-mode' mode when the file is visited -\(presuming allout-init was already run), followed by the -equivalent of `(allout-expose-topic 0 : -1 -1 0)'. (This is -the layout used for the allout.el source file.) +\(presuming proper `allout-auto-activation' customization), +followed by the equivalent of `(allout-expose-topic 0 : -1 -1 0)'. +\(This is the layout used for the allout.el source file.) `allout-default-layout' describes the specification format. `allout-layout' can additionally have the value `t', in which @@ -1437,6 +1455,11 @@ Some edits that shift items can be missed by this hook: specifically edits that native allout routines do not control. This hook might be invoked multiple times by a single command.") +;;;_ = allout-after-copy-or-kill-hook +(defvar allout-after-copy-or-kill-hook nil + "*Hook that's run after copying outline text. + +Functions on the hook should not take any arguments.") ;;;_ = allout-outside-normal-auto-fill-function (defvar allout-outside-normal-auto-fill-function nil "Value of normal-auto-fill-function outside of allout mode. @@ -1614,84 +1637,19 @@ non-nil in a lasting way.") "If t, `allout-mode's last deactivation was deliberate. So `allout-post-command-business' should not reactivate it...") (make-variable-buffer-local 'allout-explicitly-deactivated) -;;;_ > allout-init (&optional mode) -(defun allout-init (&optional mode) - "Prime `allout-mode' to enable/disable auto-activation, wrt `allout-layout'. - -MODE is one of the following symbols: - - - nil (or no argument) deactivate auto-activation/layout; - - `activate', enable auto-activation only; - - `ask', enable auto-activation, and enable auto-layout but with - confirmation for layout operation solicited from user each time; - - `report', just report and return the current auto-activation state; - - anything else (eg, t) for auto-activation and auto-layout, without - any confirmation check. - -Use this function to setup your Emacs session for automatic activation -of allout outline mode, contingent to the buffer-specific setting of -the `allout-layout' variable. (See `allout-layout' and -`allout-expose-topic' docstrings for more details on auto layout). - -`allout-init' works by setting up (or removing) the `allout-mode' -find-file-hook, and giving `allout-auto-activation' a suitable -setting. - -To prime your Emacs session for full auto-outline operation, include -the following two lines in your Emacs init file: - -\(require 'allout) -\(allout-init t)" - - (interactive) - (if (allout-called-interactively-p) - (progn - (setq mode - (completing-read - (concat "Select outline auto setup mode " - "(empty for report, ? for options) ") - '(("nil")("full")("activate")("deactivate") - ("ask") ("report") ("")) - nil - t)) - (if (string= mode "") - (setq mode 'report) - (setq mode (intern-soft mode))))) - (let - ;; convenience aliases, for consistent ref to respective vars: - ((hook 'allout-find-file-hook) - (find-file-hook-var-name (if (boundp 'find-file-hook) - 'find-file-hook - 'find-file-hooks)) - (curr-mode 'allout-auto-activation)) - - (cond ((not mode) - (set find-file-hook-var-name - (delq hook (symbol-value find-file-hook-var-name))) - (if (allout-called-interactively-p) - (message "Allout outline mode auto-activation inhibited."))) - ((eq mode 'report) - (if (not (memq hook (symbol-value find-file-hook-var-name))) - (allout-init nil) - ;; Just punt and use the reports from each of the modes: - (allout-init (symbol-value curr-mode)))) - (t (add-hook find-file-hook-var-name hook) - (set curr-mode ; `set', not `setq'! - (cond ((eq mode 'activate) - (message - "Outline mode auto-activation enabled.") - 'activate) - ((eq mode 'report) - ;; Return the current mode setting: - (allout-init mode)) - ((eq mode 'ask) - (message - (concat "Outline mode auto-activation and " - "-layout (upon confirmation) enabled.")) - 'ask) - ((message - "Outline mode auto-activation and -layout enabled.") - 'full))))))) +;;;_ > allout-init (mode) +(defun allout-init (mode) + "DEPRECATED - configure allout activation by customizing +`allout-auto-activation'. This function remains around, limited +from what it did before, for backwards compatability. + +MODE is the activation mode - see `allout-auto-activation' for +valid values." + + (custom-set-variables (list 'allout-auto-activation (format "%s" mode))) + (format "%s" mode)) +(make-obsolete 'allout-init + "customize 'allout-auto-activation' instead." "23.3") ;;;_ > allout-setup-menubar () (defun allout-setup-menubar () "Populate the current buffer's menubar with `allout-mode' stuff." @@ -1757,9 +1715,8 @@ and many other features. Below is a description of the key bindings, and then description of special `allout-mode' features and terminology. See also the outline menubar additions for quick reference to many of the -features, and see the docstring of the function `allout-init' for -instructions on priming your emacs session for automatic -activation of `allout-mode'. +features. Customize `allout-auto-activation' to prepare your +emacs session for automatic activation of `allout-mode'. The bindings are those listed in `allout-prefixed-keybindings' and `allout-unprefixed-keybindings'. We recommend customizing @@ -1843,7 +1800,8 @@ M-x outlineify-sticky Activate outline mode for current buffer, Like above 'copy-exposed', but convert topic prefixes to section.subsection... numeric format. -\\[eval-expression] (allout-init t) Setup Emacs session for outline mode +\\[customize-variable] allout-auto-activation + Prepare Emacs session for allout outline mode auto-activation. Topic Encryption @@ -1908,6 +1866,7 @@ without changes to the allout core. Here are key ones: `allout-structure-added-hook' `allout-structure-deleted-hook' `allout-structure-shifted-hook' +`allout-after-copy-or-kill-hook' Terminology @@ -2084,8 +2043,8 @@ OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be." (when (and allout-layout allout-auto-activation use-layout - (and (not (eq allout-auto-activation 'activate)) - (if (eq allout-auto-activation 'ask) + (and (not (string= allout-auto-activation "activate")) + (if (string= allout-auto-activation "ask") (if (y-or-n-p (format "Expose %s with layout '%s'? " (buffer-name) use-layout)) @@ -3440,7 +3399,7 @@ Returns the qualifying command, if any, else nil." (defun allout-find-file-hook () "Activate `allout-mode' on non-nil `allout-auto-activation', `allout-layout'. -See `allout-init' for setup instructions." +See `allout-auto-activation' for setup instructions." (if (and allout-auto-activation (not (allout-mode-p)) allout-layout) @@ -4382,17 +4341,19 @@ subtopics into siblings of the item." (depth (allout-depth))) (allout-annotate-hidden beg end) - (if (and (not beg-hidden) (not end-hidden)) - (allout-unprotected (kill-line arg)) - (kill-line arg)) - (allout-deannotate-hidden beg end) - - (if allout-numbered-bullet - (save-excursion ; Renumber subsequent topics if needed: - (if (not (save-match-data (looking-at allout-regexp))) - (allout-next-heading)) - (allout-renumber-to-depth depth))) - (run-hook-with-args 'allout-structure-deleted-hook depth (point))))) + (unwind-protect + (if (and (not beg-hidden) (not end-hidden)) + (allout-unprotected (kill-line arg)) + (kill-line arg)) + (run-hooks 'allout-after-copy-or-kill-hook) + (allout-deannotate-hidden beg end) + + (if allout-numbered-bullet + (save-excursion ; Renumber subsequent topics if needed: + (if (not (save-match-data (looking-at allout-regexp))) + (allout-next-heading)) + (allout-renumber-to-depth depth))) + (run-hook-with-args 'allout-structure-deleted-hook depth (point)))))) ;;;_ > allout-copy-line-as-kill () (defun allout-copy-line-as-kill () "Like allout-kill-topic, but save to kill ring instead of deleting." @@ -4433,15 +4394,14 @@ Topic exposure is marked with text-properties, to be used by (forward-char 1))) (allout-annotate-hidden beg (setq end (point))) - (unwind-protect + (unwind-protect ; for possible barf-if-buffer-read-only. (allout-unprotected (kill-region beg end)) - (if buffer-read-only - ;; eg, during copy-as-kill. - (allout-deannotate-hidden beg end))) + (allout-deannotate-hidden beg end) + (run-hooks 'allout-after-copy-or-kill-hook) - (save-excursion - (allout-renumber-to-depth depth)) - (run-hook-with-args 'allout-structure-deleted-hook depth (point)))) + (save-excursion + (allout-renumber-to-depth depth)) + (run-hook-with-args 'allout-structure-deleted-hook depth (point))))) ;;;_ > allout-copy-topic-as-kill () (defun allout-copy-topic-as-kill () "Like `allout-kill-topic', but save to kill ring instead of deleting." @@ -4494,8 +4454,8 @@ Topic exposure is marked with text-properties, to be used by (allout-unprotected (let ((inhibit-read-only t) (buffer-undo-list t)) - ;(remove-text-properties begin end '(allout-was-hidden t)) - ))) + (remove-text-properties begin (min end (point-max)) + '(allout-was-hidden t))))) ;;;_ > allout-hide-by-annotation (begin end) (defun allout-hide-by-annotation (begin end) "Translate text properties indicating exposure status into actual exposure." @@ -5406,8 +5366,10 @@ header and body. The elements of that list are: ;; Goto initial topic, and register preceeding stuff, if any: (if (> (allout-goto-prefix-doublechecked) start) ;; First topic follows beginning point -- register preliminary stuff: - (setq result (list (list 0 "" nil - (buffer-substring start (1- (point))))))) + (setq result + (list (list 0 "" nil + (buffer-substring-no-properties start + (1- (point))))))) (while (and (not done) (not (eobp)) ; Loop until we've covered the region. (not (> (point) end))) @@ -5426,7 +5388,7 @@ header and body. The elements of that list are: (setq strings nil) (while (> next (point)) ; Get all the exposed text in (setq strings - (cons (buffer-substring + (cons (buffer-substring-no-properties beg ;To hidden text or end of line: (progn @@ -6302,8 +6264,8 @@ save. See `allout-encrypt-unencrypted-on-saves' for more info." (defun outlineify-sticky (&optional arg) "Activate outline mode and establish file var so it is started subsequently. -See doc-string for `allout-layout' and `allout-init' for details on -setup for auto-startup." +See `allout-layout' and customization of `allout-auto-activation' +for details on preparing emacs for automatic allout activation." (interactive "P") diff --git a/lisp/apropos.el b/lisp/apropos.el index 459d12804f..70ce860e1d 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -121,15 +121,12 @@ If value is `verbose', the computed score is shown for each match." (const :tag "show scores" verbose))) (defvar apropos-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map button-buffer-map) + (let ((map (copy-keymap button-buffer-map))) + (set-keymap-parent map special-mode-map) ;; Use `apropos-follow' instead of just using the button ;; definition of RET, so that users can use it anywhere in an ;; apropos item, not just on top of a button. (define-key map "\C-m" 'apropos-follow) - (define-key map " " 'scroll-up) - (define-key map "\177" 'scroll-down) - (define-key map "q" 'quit-window) map) "Keymap used in Apropos mode.") @@ -410,7 +407,7 @@ This requires that at least 2 keywords (unless only one was given)." "Return t if DOC is really matched by the current keywords." (apropos-true-hit doc apropos-all-words)) -(define-derived-mode apropos-mode fundamental-mode "Apropos" +(define-derived-mode apropos-mode special-mode "Apropos" "Major mode for following hyperlinks in output of apropos commands. \\{apropos-mode-map}") @@ -977,7 +974,6 @@ If non-nil TEXT is a string that will be printed as a heading." (old-buffer (current-buffer)) symbol item) (set-buffer standard-output) - (apropos-mode) (if (display-mouse-p) (insert "If moving the mouse over text changes the text's color, " @@ -1069,7 +1065,7 @@ If non-nil TEXT is a string that will be printed as a heading." (apropos-print-doc 4 'apropos-plist nil)) (set (make-local-variable 'truncate-partial-width-windows) t) (set (make-local-variable 'truncate-lines) t) - (setq buffer-read-only t)))) + (apropos-mode)))) (prog1 apropos-accumulator (setq apropos-accumulator ()))) ; permit gc diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 131b0dcd95..412fed102b 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -339,7 +339,7 @@ be added." (defvar archive-local-name nil "Name of local copy of remote archive.") (defvar archive-mode-map (let ((map (make-keymap))) - (suppress-keymap map) + (set-keymap-parent map special-mode-map) (define-key map " " 'archive-next-line) (define-key map "a" 'archive-alternate-display) ;;(define-key map "c" 'archive-copy) @@ -348,15 +348,12 @@ be added." (define-key map "e" 'archive-extract) (define-key map "f" 'archive-extract) (define-key map "\C-m" 'archive-extract) - (define-key map "g" 'revert-buffer) - (define-key map "h" 'describe-mode) (define-key map "m" 'archive-mark) (define-key map "n" 'archive-next-line) (define-key map "\C-n" 'archive-next-line) (define-key map [down] 'archive-next-line) (define-key map "o" 'archive-extract-other-window) (define-key map "p" 'archive-previous-line) - (define-key map "q" 'quit-window) (define-key map "\C-p" 'archive-previous-line) (define-key map [up] 'archive-previous-line) (define-key map "r" 'archive-rename-entry) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 4c0dd64a2c..cd946e46be 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1058,7 +1058,7 @@ compatibility only." (defun bookmark-handle-bookmark (bookmark-name-or-record) "Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler' if it has none. This changes current buffer and point and returns nil, -or signals a `file-error'. +or signals a `file-error'. If BOOKMARK-NAME-OR-RECORD has no file, this is a no-op. If BOOKMARK-NAME-OR-RECORD has a file, but that file no longer exists, @@ -1475,8 +1475,7 @@ method buffers use to resolve name collisions." (defvar bookmark-bmenu-mode-map (let ((map (make-keymap))) - (suppress-keymap map t) - (define-key map "q" 'quit-window) + (set-keymap-parent map special-mode-map) (define-key map "v" 'bookmark-bmenu-select) (define-key map "w" 'bookmark-bmenu-locate) (define-key map "2" 'bookmark-bmenu-2-window) @@ -1496,7 +1495,6 @@ method buffers use to resolve name collisions." (define-key map "n" 'next-line) (define-key map "p" 'previous-line) (define-key map "\177" 'bookmark-bmenu-backup-unmark) - (define-key map "?" 'describe-mode) (define-key map "u" 'bookmark-bmenu-unmark) (define-key map "m" 'bookmark-bmenu-mark) (define-key map "l" 'bookmark-bmenu-load) @@ -1586,7 +1584,7 @@ deletion, or > if it is flagged for displaying." -(defun bookmark-bmenu-mode () +(define-derived-mode bookmark-bmenu-mode special-mode "Bookmark Menu" "Major mode for editing a list of bookmarks. Each line describes one of the bookmarks in Emacs. Letters do not insert themselves; instead, they are commands. @@ -1619,13 +1617,8 @@ Bookmark names preceded by a \"*\" have annotations. in another buffer. \\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. \\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark." - (kill-all-local-variables) - (use-local-map bookmark-bmenu-mode-map) (setq truncate-lines t) - (setq buffer-read-only t) - (setq major-mode 'bookmark-bmenu-mode) - (setq mode-name "Bookmark Menu") - (run-mode-hooks 'bookmark-bmenu-mode-hook)) + (setq buffer-read-only t)) (defun bookmark-bmenu-toggle-filenames (&optional show) diff --git a/lisp/calc/README b/lisp/calc/README index e1170fc6df..533b80baeb 100644 --- a/lisp/calc/README +++ b/lisp/calc/README @@ -72,6 +72,8 @@ Summary of changes to "Calc" Emacs 24.1 +* Support for logarithmic units added. + * Calc no longer uses the tex prefix for TeX specific unit names when using TeX or LaTeX mode. diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 71cd6c9d61..fcc3ecc1ab 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -421,6 +421,16 @@ (define-key calc-mode-map "kP" 'calc-utpp) (define-key calc-mode-map "kT" 'calc-utpt) + (define-key calc-mode-map "l" nil) + (define-key calc-mode-map "lq" 'calc-logunits-quantity) + (define-key calc-mode-map "ld" 'calc-logunits-dblevel) + (define-key calc-mode-map "ln" 'calc-logunits-nplevel) + (define-key calc-mode-map "l+" 'calc-logunits-add) + (define-key calc-mode-map "l-" 'calc-logunits-sub) + (define-key calc-mode-map "l*" 'calc-logunits-mul) + (define-key calc-mode-map "l/" 'calc-logunits-divide) + (define-key calc-mode-map "l?" 'calc-l-prefix-help) + (define-key calc-mode-map "m" nil) (define-key calc-mode-map "m?" 'calc-m-prefix-help) (define-key calc-mode-map "ma" 'calc-algebraic-mode) @@ -546,10 +556,6 @@ (define-key calc-mode-map "ud" 'calc-define-unit) (define-key calc-mode-map "ue" 'calc-explain-units) (define-key calc-mode-map "ug" 'calc-get-unit-definition) - (define-key calc-mode-map "ul+" 'calc-luplus) - (define-key calc-mode-map "ul-" 'calc-luminus) - (define-key calc-mode-map "ull" 'calc-level) - (define-key calc-mode-map "ul?" 'calc-ul-prefix-help) (define-key calc-mode-map "up" 'calc-permanent-units) (define-key calc-mode-map "ur" 'calc-remove-units) (define-key calc-mode-map "us" 'calc-simplify-units) @@ -933,8 +939,12 @@ calc-store-value calc-var-name) ("calc-stuff" calc-explain-why calcFunc-clean calcFunc-pclean calcFunc-pfloat calcFunc-pfrac) - ("calc-units" calcFunc-usimplify calcFunc-luplus -calcFunc-luminus calcFunc-fieldlevel calcFunc-powerlevel + ("calc-units" calcFunc-usimplify calcFunc-lufieldadd +calcFunc-lupoweradd calcFunc-lufieldsub calcFunc-lupowersub +calcFunc-lufieldmul calcFunc-lupowermul calcFunc-lufielddiv +calcFunc-lupowerdiv calcFunc-fieldquant calcFunc-powerquant +calcFunc-dbfieldlevel calcFunc-dbpowerlevel calcFunc-npfieldlevel +calcFunc-nppowerlevel math-build-units-table math-build-units-table-buffer math-check-unit-name math-convert-temperature math-convert-units math-extract-units math-remove-units math-simplify-units @@ -1166,7 +1176,9 @@ calc-convert-temperature calc-convert-units calc-define-unit calc-enter-units-table calc-explain-units calc-extract-units calc-get-unit-definition calc-permanent-units calc-quick-units calc-remove-units calc-simplify-units calc-undefine-unit -calc-view-units-table calc-luplus calc-luminus calc-level) +calc-view-units-table calc-logunits-quantity calc-logunits-dblevel +calc-logunits-nplevel calc-logunits-add calc-logunits-sub +calc-logunits-mul calc-logunits-divide) ("calc-vec" calc-arrange-vector calc-build-vector calc-cnorm calc-conj-transpose calc-cons calc-cross calc-kron calc-diag diff --git a/lisp/calc/calc-help.el b/lisp/calc/calc-help.el index c34c114dac..d688b31b3c 100644 --- a/lisp/calc/calc-help.el +++ b/lisp/calc/calc-help.el @@ -455,6 +455,7 @@ C-w Describe how there is no warranty for Calc." calc-h-prefix-help calc-j-prefix-help calc-k-prefix-help + calc-l-prefix-help calc-m-prefix-help calc-r-prefix-help calc-s-prefix-help @@ -662,19 +663,18 @@ C-w Describe how there is no warranty for Calc." (calc-do-prefix-help '("Simplify, Convert, Temperature-convert, Base-units" "Autorange; Remove, eXtract; Explain; View-table; 0-9" - "Define, Undefine, Get-defn, Permanent, Logarithmic" + "Define, Undefine, Get-defn, Permanent" "SHIFT + View-table-other-window" "SHIFT + stat: Mean, G-mean, Std-dev, Covar, maX, miN" "SHIFT + stat: + (sum), - (asum), * (prod), # (count)") "units/stat" ?u)) -(defun calc-ul-prefix-help () +(defun calc-l-prefix-help () (interactive) - (if (eq this-command last-command) - (message "ul-") - (message "logarithmic-units: + (logarithmic), - (logarithmic), Level: ul-")) - (push ?l unread-command-events) - (push ?u unread-command-events)) + (calc-do-prefix-help + '("Quantity, DB level, Np level" + "+, -, *, /") + "log units" ?l)) (defun calc-v-prefix-help () (interactive) diff --git a/lisp/calc/calc-mtx.el b/lisp/calc/calc-mtx.el index 9941c11ff1..5ec15005b4 100644 --- a/lisp/calc/calc-mtx.el +++ b/lisp/calc/calc-mtx.el @@ -232,6 +232,20 @@ (setq math-lud-cache (cons (cons m entry) math-lud-cache))) lud)))) + +(defun math-lud-pivot-check (a) + "Determine a useful value for checking the size of potential pivots +in LUD decomposition." + (cond ((eq (car-safe a) 'mod) + (if (and (math-integerp (nth 1 a)) + (math-integerp (nth 2 a)) + (eq (math-gcd (nth 1 a) (nth 2 a)) 1)) + 1 + 0)) + (t + (math-abs-approx a)))) + + ;;; Numerical Recipes section 2.3; implicit pivoting omitted. (defun math-do-matrix-lud (m) (let* ((lu (math-copy-matrix m)) @@ -261,7 +275,7 @@ (nth j (nth k lu)))) k (1+ k))) (setcar (nthcdr j (nth i lu)) sum) - (let ((dum (math-abs-approx sum))) + (let ((dum (math-lud-pivot-check sum))) (if (Math-lessp big dum) (setq big dum imax i))) diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 782d2c4662..569d5d3dc3 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -1567,7 +1567,7 @@ If EXPR is nil, return nil." (list '^ (math-extract-logunits (nth 1 expr)) (nth 2 expr)) (if (member expr math-logunits) expr 1)))) -(defun math-logcombine (a b neg) +(defun math-logunits-add (a b neg power) (let ((aunit (math-simplify (math-extract-logunits a)))) (if (not (eq (car-safe aunit) 'var)) (calc-record-why "*Improper logarithmic unit" aunit) @@ -1583,93 +1583,263 @@ If EXPR is nil, return nil." (calc-record-why "*Improper coefficients" nil) (math-mul (if (equal aunit '(var dB var-dB)) - (math-mul 10 - (calcFunc-log10 - (if neg - (math-sub - (math-pow 10 (math-div acoeff 10)) - (math-pow 10 (math-div bcoeff 10))) - (math-add - (math-pow 10 (math-div acoeff 10)) - (math-pow 10 (math-div bcoeff 10)))))) - (calcFunc-ln - (if neg - (math-sub - (calcFunc-exp acoeff) - (calcFunc-exp bcoeff)) - (math-add - (calcFunc-exp acoeff) - (calcFunc-exp bcoeff))))) + (let ((coef (if power 10 20))) + (math-mul coef + (calcFunc-log10 + (if neg + (math-sub + (math-pow 10 (math-div acoeff coef)) + (math-pow 10 (math-div bcoeff coef))) + (math-add + (math-pow 10 (math-div acoeff coef)) + (math-pow 10 (math-div bcoeff coef))))))) + (let ((coef (if power 2 1))) + (math-div + (calcFunc-ln + (if neg + (math-sub + (calcFunc-exp (math-mul coef acoeff)) + (calcFunc-exp (math-mul coef bcoeff))) + (math-add + (calcFunc-exp (math-mul coef acoeff)) + (calcFunc-exp (math-mul coef bcoeff))))) + coef))) units))))))) -(defun calcFunc-luplus (a b) - (math-logcombine a b nil)) +(defun calcFunc-lufieldplus (a b) + (math-logunits-add a b nil nil)) -(defun calcFunc-luminus (a b) - (math-logcombine a b t)) +(defun calcFunc-lupowerplus (a b) + (math-logunits-add a b nil t)) -(defun calc-luplus (arg) +(defun calcFunc-lufieldminus (a b) + (math-logunits-add a b t nil)) + +(defun calcFunc-lupowerminus (a b) + (math-logunits-add a b t t)) + +(defun calc-logunits-add (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-inverse) - (calc-binary-op "lu-" 'calcFunc-luminus arg) - (calc-binary-op "lu+" 'calcFunc-luplus arg)))) - -(defun calc-luminus (arg) + (if (calc-is-hyperbolic) + (calc-binary-op "lu-" 'calcFunc-lufieldminus arg) + (calc-binary-op "lu-" 'calcFunc-lupowerminus arg)) + (if (calc-is-hyperbolic) + (calc-binary-op "lu+" 'calcFunc-lufieldplus arg) + (calc-binary-op "lu+" 'calcFunc-lupowerplus arg))))) + +(defun calc-logunits-sub (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-inverse) + (if (calc-is-hyperbolic) + (calc-binary-op "lu+" 'calcFunc-lufieldplus arg) + (calc-binary-op "lu+" 'calcFunc-lupowerplus arg)) + (if (calc-is-hyperbolic) + (calc-binary-op "lu-" 'calcFunc-lufieldminus arg) + (calc-binary-op "lu-" 'calcFunc-lupowerminus arg))))) + +(defun math-logunits-mul (a b power) + (let (logunit coef units number) + (cond + ((and + (setq logunit (math-simplify (math-extract-logunits a))) + (eq (car-safe logunit) 'var) + (eq (math-simplify (math-extract-units b)) 1)) + (setq coef (math-simplify (math-remove-units a)) + units (math-extract-units a) + number b)) + ((and + (setq logunit (math-simplify (math-extract-logunits b))) + (eq (car-safe logunit) 'var) + (eq (math-simplify (math-extract-units a)) 1)) + (setq coef (math-simplify (math-remove-units b)) + units (math-extract-units b) + number a)) + (t (setq logunit nil))) + (if logunit + (cond + ((equal logunit '(var dB var-dB)) + (math-simplify + (math-mul + (math-add + coef + (math-mul (if power 10 20) + (calcFunc-log10 number))) + units))) + (t + (math-simplify + (math-mul + (math-add + coef + (math-div (calcFunc-ln number) (if power 2 1))) + units)))) + (calc-record-why "*Improper units" nil)))) + +(defun math-logunits-divide (a b power) + (let ((logunit (math-simplify (math-extract-logunits a)))) + (if (not (eq (car-safe logunit) 'var)) + (calc-record-why "*Improper logarithmic unit" logunit) + (if (math-units-in-expr-p b nil) + (calc-record-why "*Improper units quantity" b) + (let* ((units (math-extract-units a)) + (coef (math-simplify (math-remove-units a)))) + (cond + ((equal logunit '(var dB var-dB)) + (math-simplify + (math-mul + (math-sub + coef + (math-mul (if power 10 20) + (calcFunc-log10 b))) + units))) + (t + (math-simplify + (math-mul + (math-sub + coef + (math-div (calcFunc-ln b) (if power 2 1))) + units))))))))) + +(defun calcFunc-lufieldtimes (a b) + (math-logunits-mul a b nil)) + +(defun calcFunc-lupowertimes (a b) + (math-logunits-mul a b t)) + +(defun calc-logunits-mul (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-inverse) - (calc-binary-op "lu+" 'calcFunc-luplus arg) - (calc-binary-op "lu-" 'calcFunc-luminus arg)))) + (if (calc-is-hyperbolic) + (calc-binary-op "lu/" 'calcFunc-lufielddiv arg) + (calc-binary-op "lu/" 'calcFunc-lupowerdiv arg)) + (if (calc-is-hyperbolic) + (calc-binary-op "lu*" 'calcFunc-lufieldtimes arg) + (calc-binary-op "lu*" 'calcFunc-lupowertimes arg))))) -;(defun calcFunc-lmul (a b) +(defun calcFunc-lufielddiv (a b) + (math-logunits-divide a b nil)) +(defun calcFunc-lupowerdiv (a b) + (math-logunits-divide a b t)) -(defun math-logunit-level (val ref power) - (let ((lunit (math-simplify (math-extract-logunits val)))) +(defun calc-logunits-divide (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-inverse) + (if (calc-is-hyperbolic) + (calc-binary-op "lu*" 'calcFunc-lufieldtimes arg) + (calc-binary-op "lu*" 'calcFunc-lupowertimes arg)) + (if (calc-is-hyperbolic) + (calc-binary-op "lu/" 'calcFunc-lufielddiv arg) + (calc-binary-op "lu/" 'calcFunc-lupowerdiv arg))))) + +(defun math-logunits-quant (val ref power) + (let* ((units (math-simplify (math-extract-units val))) + (lunit (math-simplify (math-extract-logunits units)))) (if (not (eq (car-safe lunit) 'var)) (calc-record-why "*Improper logarithmic unit" lunit) - (if (not (eq 1 (math-simplify (math-extract-units (math-div val lunit))))) - (calc-record-why "*Inappropriate units" nil) - (let ((coeff (math-simplify (math-div val lunit)))) - (if (equal lunit '(var dB var-dB)) - (math-mul - ref - (math-pow - 10 - (math-div - coeff - (if power 10 20)))) - (math-mul - ref - (calcFunc-exp - (if power - (math-mul 2 coeff) - coeff))))))))) + (let ((runits (math-simplify (math-div units lunit))) + (coeff (math-simplify (math-div val units)))) + (math-mul + (if (equal lunit '(var dB var-dB)) + (math-mul + ref + (math-pow + 10 + (math-div + coeff + (if power 10 20)))) + (math-mul + ref + (calcFunc-exp + (if power + (math-mul 2 coeff) + coeff)))) + runits))))) + +(defvar calc-logunits-field-reference) +(defvar calc-logunits-power-reference) + +(defun calcFunc-fieldquant (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-logunits-field-reference))) + (math-logunits-quant val ref nil)) + +(defun calcFunc-powerquant (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-logunits-power-reference))) + (math-logunits-quant val ref t)) -(defvar calc-default-field-reference-level) -(defvar calc-default-power-reference-level) +(defun calc-logunits-quantity (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-hyperbolic) + (if (calc-is-option) + (calc-binary-op "lupq" 'calcFunc-fieldquant arg) + (calc-unary-op "lupq" 'calcFunc-fieldquant arg)) + (if (calc-is-option) + (calc-binary-op "lufq" 'calcFunc-powerquant arg) + (calc-unary-op "lufq" 'calcFunc-powerquant arg))))) + +(defun math-logunits-level (val ref db power) + "Compute the value of VAL in decibels or nepers." + (let* ((ratio (math-simplify-units (math-div val ref))) + (units (math-simplify (math-extract-units ratio)))) + (math-mul + (if db + (math-mul + (math-mul (if power 10 20) + (calcFunc-log10 ratio)) + '(var dB var-dB)) + (math-mul + (math-div (calcFunc-ln ratio) (if power 2 1)) + '(var Np var-Np))) + units))) + +(defun calcFunc-dbfieldlevel (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-logunits-field-reference))) + (math-logunits-level val ref t nil)) + +(defun calcFunc-dbpowerlevel (val &optional ref) + (unless ref + (setq ref (math-read-expr calc-logunits-power-reference))) + (math-logunits-level val ref t t)) -(defun calcFunc-fieldlevel (val &optional ref) +(defun calcFunc-npfieldlevel (val &optional ref) (unless ref - (setq ref (math-read-expr calc-default-field-reference-level))) - (math-logunit-level val ref nil)) + (setq ref (math-read-expr calc-logunits-field-reference))) + (math-logunits-level val ref nil nil)) -(defun calcFunc-powerlevel (val &optional ref) +(defun calcFunc-nppowerlevel (val &optional ref) (unless ref - (setq ref (math-read-expr calc-default-power-reference-level))) - (math-logunit-level val ref t)) + (setq ref (math-read-expr calc-logunits-power-reference))) + (math-logunits-level val ref nil t)) + +(defun calc-logunits-dblevel (arg) + (interactive "P") + (calc-slow-wrapper + (if (calc-is-hyperbolic) + (if (calc-is-option) + (calc-binary-op "ludb" 'calcFunc-dbfieldlevel arg) + (calc-unary-op "ludb" 'calcFunc-dbfieldlevel arg)) + (if (calc-is-option) + (calc-binary-op "ludb" 'calcFunc-dbpowerlevel arg) + (calc-unary-op "ludb" 'calcFunc-dbpowerlevel arg))))) -(defun calc-level (arg) +(defun calc-logunits-nplevel (arg) (interactive "P") (calc-slow-wrapper (if (calc-is-hyperbolic) (if (calc-is-option) - (calc-binary-op "plvl" 'calcFunc-powerlevel arg) - (calc-unary-op "plvl" 'calcFunc-powerlevel arg)) + (calc-binary-op "lunp" 'calcFunc-npfieldlevel arg) + (calc-unary-op "lunp" 'calcFunc-npfieldlevel arg)) (if (calc-is-option) - (calc-binary-op "flvl" 'calcFunc-fieldlevel arg) - (calc-unary-op "flvl" 'calcFunc-fieldlevel arg))))) + (calc-binary-op "lunp" 'calcFunc-nppowerlevel arg) + (calc-unary-op "lunp" 'calcFunc-nppowerlevel arg))))) (provide 'calc-units) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 8316111597..72ddddeb32 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -434,13 +434,13 @@ by displaying the sub-formula in `calc-selected-face'." :group 'calc :type 'boolean) -(defcustom calc-default-field-reference-level +(defcustom calc-logunits-field-reference "20 uPa" "The default reference level for logarithmic units (field)." :group 'calc :type '(string)) -(defcustom calc-default-power-reference-level +(defcustom calc-logunits-power-reference "mW" "The default reference level for logarithmic units (power)." :group 'calc diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 0bbdeccee6..2d162a5060 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -2331,9 +2331,19 @@ return a font-lock pattern matching array of MONTHS and marking SYMBOL." t)) '(1 font-lock-reference-face)) '(diary-font-lock-sexps . font-lock-keyword-face) + ;; Don't need to worry about space around "-" because the first + ;; match takes care of that. It does mean the "-" itself may or + ;; may not be fontified though. + ;; diary-date-forms often include a final character that is not + ;; part of the date (eg a non-digit to mark the end of the year). + ;; This can use up the only space char between a date and time (b#7891). + ;; Hence we use OVERRIDE, which can only override whitespace. + ;; FIXME it's probably better to tighten up the diary-time-regexp + ;; and drop the whitespace requirement below. `(,(format "\\(^\\|\\s-\\)%s\\(-%s\\)?" diary-time-regexp diary-time-regexp) - . 'diary-time)))) + . (0 'diary-time t))))) +; . 'diary-time)))) (defvar diary-font-lock-keywords (diary-font-lock-keywords) "Forms to highlight in `diary-mode'.") @@ -2409,12 +2419,10 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." (setq end (line-beginning-position 2))) (font-lock-default-fontify-region beg end verbose)) -(defvar diary-fancy-overriding-map (let ((map (make-sparse-keymap))) - (define-key map "q" 'quit-window) - map) +(defvar diary-fancy-overriding-map (make-sparse-keymap) "Keymap overriding minor-mode maps in `diary-fancy-display-mode'.") -(define-derived-mode diary-fancy-display-mode fundamental-mode +(define-derived-mode diary-fancy-display-mode special-mode "Diary" "Major mode used while displaying diary entries using Fancy Display." (set (make-local-variable 'font-lock-defaults) @@ -2422,7 +2430,6 @@ Fontify the region between BEG and END, quietly unless VERBOSE is non-nil." t nil nil nil (font-lock-fontify-region-function . diary-fancy-font-lock-fontify-region-function))) - (local-set-key "q" 'quit-window) (set (make-local-variable 'minor-mode-overriding-map-alist) (list (cons t diary-fancy-overriding-map))) (view-mode 1)) diff --git a/lisp/color.el b/lisp/color.el index 5c95fffbfa..3874e33bfb 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -47,6 +47,20 @@ RED GREEN BLUE must be values between 0 and 1 inclusively." (- 1.0 (cadr color)) (- 1.0 (caddr color))))) +(defun color-gradient (start stop step-number) + "Return a list with STEP-NUMBER colors from START to STOP. +The color list builds a color gradient starting at color START to +color STOP. It does not include the START and STOP color in the +resulting list." + (loop for i from 1 to step-number + with red-step = (/ (- (car stop) (car start)) (1+ step-number)) + with green-step = (/ (- (cadr stop) (cadr start)) (1+ step-number)) + with blue-step = (/ (- (caddr stop) (caddr start)) (1+ step-number)) + collect (list + (+ (car start) (* i red-step)) + (+ (cadr start) (* i green-step)) + (+ (caddr start) (* i blue-step))))) + (defun color-complement-hex (color) "Return the color that is the complement of COLOR, in hexadecimal format." (apply 'color-rgb->hex (color-complement color))) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index f29dd9eb21..cdc066aa91 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -621,7 +621,9 @@ Theme files are named *-theme.el in `")) (let ((this-theme (widget-get widget :theme-name))) (if (widget-value widget) ;; Disable the theme. - (disable-theme this-theme) + (progn + (disable-theme this-theme) + (widget-toggle-action widget event)) ;; Enable the theme. (unless custom-theme-allow-multiple-selections ;; If only one theme is allowed, disable all other themes and @@ -634,12 +636,11 @@ Theme files are named *-theme.el in `")) (unless (eq (car theme) this-theme) (widget-value-set (cdr theme) nil) (widget-apply (cdr theme) :notify (cdr theme) event)))) - (load-theme this-theme))) - ;; Mark `custom-enabled-themes' as "set for current session". - (put 'custom-enabled-themes 'customized-value - (list (custom-quote custom-enabled-themes))) - ;; Check/uncheck the widget. - (widget-toggle-action widget event)) + (when (load-theme this-theme) + (widget-toggle-action widget event))) + ;; Mark `custom-enabled-themes' as "set for current session". + (put 'custom-enabled-themes 'customized-value + (list (custom-quote custom-enabled-themes))))) (defun custom-describe-theme () "Describe the Custom theme on the current line." diff --git a/lisp/custom.el b/lisp/custom.el index e31948ec4b..e41e7c7bdf 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1116,16 +1116,15 @@ Emacs theme directory (a directory named \"themes\" in :risky t :version "24.1") -(defvar safe-functions) ; From unsafep.el - (defun load-theme (theme &optional no-enable) - "Load a theme's settings from its file. -Normally, this also enables the theme; use `disable-theme' to -disable it. If optional arg NO-ENABLE is non-nil, don't enable -the theme. + "Load Custom theme named THEME from its file. +Normally, this also enables THEME. If optional arg NO-ENABLE is +non-nil, load THEME but don't enable it. + +The theme file is named THEME-theme.el, in one of the directories +specified by `custom-theme-load-path'. -A theme file is named THEME-theme.el, where THEME is the theme name, -in one of the directories specified by `custom-theme-load-path'." +Return t if THEME was successfully loaded, nil otherwise." (interactive (list (intern (completing-read "Load custom theme: " @@ -1148,30 +1147,16 @@ in one of the directories specified by `custom-theme-load-path'." (with-temp-buffer (insert-file-contents fn) (setq hash (sha1 (current-buffer))) - ;; Check file safety. + ;; Check file safety with `custom-safe-themes', prompting the + ;; user if necessary. (when (or (and (memq 'default custom-safe-themes) (equal (file-name-directory fn) (expand-file-name "themes/" data-directory))) (member hash custom-safe-themes) - ;; If the theme is not in `custom-safe-themes', check - ;; it with unsafep. - (progn - (require 'unsafep) - (let ((safe-functions - (append '(provide-theme deftheme - custom-theme-set-variables - custom-theme-set-faces) - safe-functions)) - unsafep form) - (while (and (setq form (condition-case nil - (let ((read-circle nil)) - (read (current-buffer))) - (end-of-file nil))) - (null (setq unsafep (unsafep form))))) - (or (null unsafep) - (custom-theme-load-confirm hash))))) + (custom-theme-load-confirm hash)) (let ((custom--inhibit-theme-enable no-enable)) - (eval-buffer)))))) + (eval-buffer) + t))))) (defun custom-theme-load-confirm (hash) "Query the user about loading a Custom theme that may not be safe. @@ -1180,32 +1165,35 @@ query also about adding HASH to `custom-safe-themes'." (if noninteractive nil (let ((exit-chars '(?y ?n ?\s)) - prompt char) + window prompt char) (save-window-excursion (rename-buffer "*Custom Theme*" t) (emacs-lisp-mode) - (display-buffer (current-buffer)) + (setq window (display-buffer (current-buffer))) (setq prompt - (format "This theme is not guaranteed to be safe. Really load? %s" - (if (< (line-number-at-pos (point-max)) - (window-body-height)) - "(y or n) " + (format "Loading a theme can run Lisp code. Really load?%s" + (if (and window + (< (line-number-at-pos (point-max)) + (window-body-height))) + " (y or n) " (push ?\C-v exit-chars) - "Type y or n, or C-v to scroll: "))) + "\nType y or n, or C-v to scroll: "))) (goto-char (point-min)) (while (null char) (setq char (read-char-choice prompt exit-chars)) (when (eq char ?\C-v) - (condition-case nil - (scroll-up) - (error (goto-char (point-min)))) + (if window + (with-selected-window window + (condition-case nil + (scroll-up) + (error (goto-char (point-min)))))) (setq char nil))) (when (memq char '(?\s ?y)) - (push hash custom-safe-themes) ;; Offer to save to `custom-safe-themes'. (and (or custom-file user-init-file) - (y-or-n-p "Treat this theme as safe for future loads? ") + (y-or-n-p "Treat this theme as safe in future sessions? ") (let ((coding-system-for-read nil)) + (push hash custom-safe-themes) (customize-save-variable 'custom-safe-themes custom-safe-themes))) t))))) @@ -1285,7 +1273,8 @@ This does not include the `user' theme, which is set by Customize, and always takes precedence over other Custom Themes." :group 'customize :type '(repeat symbol) - :set-after '(custom-theme-directory custom-theme-load-path) + :set-after '(custom-theme-directory custom-theme-load-path + custom-safe-themes) :risky t :set (lambda (symbol themes) ;; Avoid an infinite loop when custom-enabled-themes is diff --git a/lisp/dired.el b/lisp/dired.el index 92cbdd32c8..c4b45a3aa8 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1052,6 +1052,8 @@ BEG..END is the line where the file info is located." (set-marker file nil))))) +(defvar ls-lisp-use-insert-directory-program) + (defun dired-insert-directory (dir switches &optional file-list wildcard hdr) "Insert a directory listing of DIR, Dired style. Use SWITCHES to make the listings. @@ -1063,14 +1065,20 @@ If HDR is non-nil, insert a header line with the directory name." (let ((opoint (point)) (process-environment (copy-sequence process-environment)) end) - (if (or (if (eq dired-use-ls-dired 'unspecified) - ;; Check whether "ls --dired" gives exit code 0, and - ;; save the answer in `dired-use-ls-dired'. - (setq dired-use-ls-dired - (eq (call-process insert-directory-program nil nil nil "--dired") - 0)) - dired-use-ls-dired) - (file-remote-p dir)) + (if (and + ;; Don't try to invoke `ls' if we are on DOS/Windows where + ;; ls-lisp emulation is used, except if they want to use `ls' + ;; as indicated by `ls-lisp-use-insert-directory-program'. + (not (and (featurep 'ls-lisp) + (null ls-lisp-use-insert-directory-program))) + (or (if (eq dired-use-ls-dired 'unspecified) + ;; Check whether "ls --dired" gives exit code 0, and + ;; save the answer in `dired-use-ls-dired'. + (setq dired-use-ls-dired + (eq (call-process insert-directory-program nil nil nil "--dired") + 0)) + dired-use-ls-dired) + (file-remote-p dir))) (setq switches (concat "--dired " switches))) ;; We used to specify the C locale here, to force English month names; ;; but this should not be necessary any more, @@ -1294,7 +1302,7 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." ;; This looks ugly when substitute-command-keys uses C-d instead d: ;; (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion) (let ((map (make-keymap))) - (suppress-keymap map) + (set-keymap-parent map special-mode-map) (define-key map [mouse-2] 'dired-mouse-find-file-other-window) (define-key map [follow-link] 'mouse-face) ;; Commands to mark or flag certain categories of files @@ -1373,7 +1381,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "\C-m" 'dired-find-file) (put 'dired-find-file :advertised-binding "\C-m") (define-key map "g" 'revert-buffer) - (define-key map "h" 'describe-mode) (define-key map "i" 'dired-maybe-insert-subdir) (define-key map "j" 'dired-goto-file) (define-key map "k" 'dired-do-kill-lines) @@ -1383,7 +1390,6 @@ Do so according to the former subdir alist OLD-SUBDIR-ALIST." (define-key map "o" 'dired-find-file-other-window) (define-key map "\C-o" 'dired-display-file) (define-key map "p" 'dired-previous-line) - (define-key map "q" 'quit-window) (define-key map "s" 'dired-sort-toggle-or-edit) (define-key map "t" 'dired-toggle-marks) (define-key map "u" 'dired-unmark) @@ -2027,7 +2033,7 @@ Otherwise, an error occurs in these cases." ;; with quotation marks in their names. (while (string-match "\\(?:[^\\]\\|\\`\\)\\(\"\\)" file) (setq file (replace-match "\\\"" nil t file 1))) - + (when (eq system-type 'windows-nt) (save-match-data (let ((start 0)) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 05bfa0f262..e10dc10447 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -282,7 +282,7 @@ Not documented ;;;;;; do-all-symbols do-symbols dotimes dolist do* do loop return-from ;;;;;; return block etypecase typecase ecase case load-time-value ;;;;;; eval-when destructuring-bind function* defmacro* defun* gentemp -;;;;;; gensym) "cl-macs" "cl-macs.el" "8b2ce9c2ec0e273606bb37c333c4bdde") +;;;;;; gensym) "cl-macs" "cl-macs.el" "0904b956872432ae7cc5fa9abcefce63") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ @@ -389,7 +389,7 @@ This is equivalent to `(return-from nil RESULT)'. (autoload 'return-from "cl-macs" "\ Return from the block named NAME. -This jump out to the innermost enclosing `(block NAME ...)' form, +This jumps out to the innermost enclosing `(block NAME ...)' form, returning RESULT from that form (or nil if RESULT is omitted). This is compatible with Common Lisp, but note that `defun' and `defmacro' do not create implicit blocks as they do in Common Lisp. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index bef334b544..80e95724f1 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -628,7 +628,7 @@ This is equivalent to `(return-from nil RESULT)'." ;;;###autoload (defmacro return-from (name &optional result) "Return from the block named NAME. -This jump out to the innermost enclosing `(block NAME ...)' form, +This jumps out to the innermost enclosing `(block NAME ...)' form, returning RESULT from that form (or nil if RESULT is omitted). This is compatible with Common Lisp, but note that `defun' and `defmacro' do not create implicit blocks as they do in Common Lisp." diff --git a/lisp/emacs-lisp/cl-specs.el b/lisp/emacs-lisp/cl-specs.el index 7359da65e0..3556b6c1ec 100644 --- a/lisp/emacs-lisp/cl-specs.el +++ b/lisp/emacs-lisp/cl-specs.el @@ -67,7 +67,7 @@ (def-edebug-spec multiple-value-list (form)) (def-edebug-spec multiple-value-call (function-form body)) (def-edebug-spec multiple-value-bind - ((&rest symbolp) form cl-declarations body)) + ((&rest symbolp) form body)) (def-edebug-spec multiple-value-setq ((&rest symbolp) form)) (def-edebug-spec multiple-value-prog1 (form body)) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 7932309cff..d711ba59a4 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3396,7 +3396,7 @@ go to the end of the last sexp, or if that is the same point, then step." ;; Return the function symbol, or nil if not instrumented. (let ((func-marker (get func 'edebug))) (cond - ((markerp func-marker) + ((and (markerp func-marker) (marker-buffer func-marker)) ;; It is uninstrumented, so instrument it. (with-current-buffer (marker-buffer func-marker) (goto-char func-marker) diff --git a/lisp/emacs-lisp/elint.el b/lisp/emacs-lisp/elint.el index 36c26676fe..0b8aa03450 100644 --- a/lisp/emacs-lisp/elint.el +++ b/lisp/emacs-lisp/elint.el @@ -122,7 +122,6 @@ are as follows, and suppress messages about the indicated features: ;; FIXME I don't see why they shouldn't just get doc-strings. '(vc-mode local-write-file-hooks activate-menubar-hook buffer-name-history coding-system-history extended-command-history - kbd-macro-termination-hook read-expression-history yes-or-no-p-history) "Standard variables, excluding `elint-builtin-variables'. These are variables that we cannot detect automatically for some reason.") diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 7ee8146323..695dc1e2db 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1874,11 +1874,9 @@ BUFFER-NAME, if non-nil, is the buffer name to use." (unless buffer-name (setq buffer-name "*ert*")) (let ((buffer (get-buffer-create buffer-name))) (with-current-buffer buffer - (setq buffer-read-only t) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) - (ert-results-mode) ;; Erase buffer again in case switching out of the previous ;; mode inserted anything. (This happens e.g. when switching ;; from ert-results-mode to ert-results-mode when @@ -1897,8 +1895,9 @@ BUFFER-NAME, if non-nil, is the buffer name to use." (ewoc-enter-last ewoc (make-ert--ewoc-entry :test test :hidden-p t))) (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) - (goto-char (1- (point-max))) - buffer))))) + (goto-char (1- (point-max))))) + (ert-results-mode) + buffer))) (defvar ert--selector-history nil @@ -1997,19 +1996,12 @@ and how to display message." ;;; Simple view mode for auxiliary information like stack traces or ;;; messages. Mainly binds "q" for quit. -(define-derived-mode ert-simple-view-mode fundamental-mode "ERT-View" +(define-derived-mode ert-simple-view-mode special-mode "ERT-View" "Major mode for viewing auxiliary information in ERT.") -(loop for (key binding) in - '(("q" quit-window) - ) - do - (define-key ert-simple-view-mode-map key binding)) - - ;;; Commands and button actions for the results buffer. -(define-derived-mode ert-results-mode fundamental-mode "ERT-Results" +(define-derived-mode ert-results-mode special-mode "ERT-Results" "Major mode for viewing results of ERT test runs.") (loop for (key binding) in @@ -2017,7 +2009,6 @@ and how to display message." ("\t" forward-button) ([backtab] backward-button) ("j" ert-results-jump-between-summary-and-result) - ("q" quit-window) ("L" ert-results-toggle-printer-limits-for-test-at-point) ("n" ert-results-next-test) ("p" ert-results-previous-test) @@ -2349,11 +2340,9 @@ To be used in the ERT results buffer." (let ((backtrace (ert-test-result-with-condition-backtrace result)) (buffer (get-buffer-create "*ERT Backtrace*"))) (pop-to-buffer buffer) - (setq buffer-read-only t) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) - (ert-simple-view-mode) ;; Use unibyte because `debugger-setup-buffer' also does so. (set-buffer-multibyte nil) (setq truncate-lines t) @@ -2362,7 +2351,8 @@ To be used in the ERT results buffer." (goto-char (point-min)) (insert "Backtrace for test `") (ert-insert-test-name-button (ert-test-name test)) - (insert "':\n"))))))) + (insert "':\n") + (ert-simple-view-mode))))))) (defun ert-results-pop-to-messages-for-test-at-point () "Display the part of the *Messages* buffer generated during the test at point. @@ -2375,16 +2365,15 @@ To be used in the ERT results buffer." (result (aref (ert--stats-test-results stats) pos))) (let ((buffer (get-buffer-create "*ERT Messages*"))) (pop-to-buffer buffer) - (setq buffer-read-only t) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) - (ert-simple-view-mode) (insert (ert-test-result-messages result)) (goto-char (point-min)) (insert "Messages for test `") (ert-insert-test-name-button (ert-test-name test)) - (insert "':\n"))))) + (insert "':\n") + (ert-simple-view-mode))))) (defun ert-results-pop-to-should-forms-for-test-at-point () "Display the list of `should' forms executed during the test at point. @@ -2397,11 +2386,9 @@ To be used in the ERT results buffer." (result (aref (ert--stats-test-results stats) pos))) (let ((buffer (get-buffer-create "*ERT list of should forms*"))) (pop-to-buffer buffer) - (setq buffer-read-only t) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) - (ert-simple-view-mode) (if (null (ert-test-result-should-forms result)) (insert "\n(No should forms during this test.)\n") (loop for form-description in (ert-test-result-should-forms result) @@ -2419,7 +2406,8 @@ To be used in the ERT results buffer." (insert (concat "(Values are shallow copies and may have " "looked different during the test if they\n" "have been modified destructively.)\n")) - (forward-line 1))))) + (forward-line 1) + (ert-simple-view-mode))))) (defun ert-results-toggle-printer-limits-for-test-at-point () "Toggle how much of the condition to print for the test at point. @@ -2451,11 +2439,9 @@ To be used in the ERT results buffer." (setq data (sort data (lambda (a b) (> (second a) (second b))))) (pop-to-buffer buffer) - (setq buffer-read-only t) (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) - (ert-simple-view-mode) (if (null data) (insert "(No data)\n") (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) @@ -2468,7 +2454,8 @@ To be used in the ERT results buffer." (insert "\n")))) (goto-char (point-min)) (insert "Tests by run time (seconds):\n\n") - (forward-line 1)))) + (forward-line 1) + (ert-simple-view-mode)))) ;;;###autoload (defun ert-describe-test (test-or-test-name) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 59964ff6b9..af97bb1bd2 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1213,18 +1213,16 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." ;;;; Package menu mode. (defvar package-menu-mode-map - (let ((map (make-keymap)) + (let ((map (copy-keymap special-mode-map)) (menu-map (make-sparse-keymap "Package"))) (set-keymap-parent map button-buffer-map) (define-key map "\C-m" 'package-menu-describe-package) - (define-key map "q" 'quit-window) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) (define-key map "u" 'package-menu-mark-unmark) (define-key map "\177" 'package-menu-backup-unmark) (define-key map "d" 'package-menu-mark-delete) (define-key map "i" 'package-menu-mark-install) - (define-key map "g" 'revert-buffer) (define-key map "r" 'package-menu-refresh) (define-key map "~" 'package-menu-mark-obsolete-for-deletion) (define-key map "x" 'package-menu-execute) @@ -1290,15 +1288,11 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages." (put 'package-menu-mode 'mode-class 'special) -(defun package-menu-mode () +(define-derived-mode package-menu-mode special-mode "Package Menu" "Major mode for browsing a list of packages. Letters do not insert themselves; instead, they are commands. \\<package-menu-mode-map> \\{package-menu-mode-map}" - (kill-all-local-variables) - (use-local-map package-menu-mode-map) - (setq major-mode 'package-menu-mode) - (setq mode-name "Package Menu") (setq truncate-lines t) (setq buffer-read-only t) (set (make-local-variable 'revert-buffer-function) 'package-menu-revert) @@ -1326,8 +1320,7 @@ Letters do not insert themselves; instead, they are commands. (20 . "Version") (32 . "Status") (43 . "Description")) - "")) - (run-mode-hooks 'package-menu-mode-hook)) + ""))) (defun package-menu-refresh () "Download the Emacs Lisp package archive. @@ -1665,10 +1658,10 @@ list; the default is to display everything in `package-alist'." (require 'finder-inf nil t) (let ((buf (get-buffer-create "*Packages*"))) (with-current-buffer buf - (package-menu-mode) (set (make-local-variable 'package-menu-package-list) packages) (set (make-local-variable 'package-menu-sort-key) nil) - (package--generate-package-list)) + (package--generate-package-list) + (package-menu-mode)) ;; The package menu buffer has keybindings. If the user types ;; `M-x list-packages', that suggests it should become current. (switch-to-buffer buf))) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index e3c030b3c6..59a30d62b0 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -275,6 +275,13 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (set (make-local-variable 'blink-matching-paren) nil) (reb-mode-common)) +(defvar reb-lisp-mode-map + (let ((map (make-sparse-keymap))) + ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from + ;; `emacs-lisp-mode' + (define-key map "\C-c" (lookup-key reb-mode-map "\C-c")) + map)) + (define-derived-mode reb-lisp-mode emacs-lisp-mode "RE Builder Lisp" "Major mode for interactively building symbolic Regular Expressions." @@ -283,11 +290,6 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (require 'rx))) ; require rx anyway (reb-mode-common)) -;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from -;; `emacs-lisp-mode' -(define-key reb-lisp-mode-map "\C-c" - (lookup-key reb-mode-map "\C-c")) - (defvar reb-subexp-mode-map (let ((m (make-keymap))) (suppress-keymap m) diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index c5bad3bd40..d5bba20b1c 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -115,7 +115,7 @@ See the documentation for `list-load-path-shadows' for further information." ;; FILE now contains the current file name, with no suffix. (unless (or (member file files-seen-this-dir) ;; Ignore these files. - (member file '("subdirs"))) + (member file '("subdirs" "leim-list"))) ;; File has not been seen yet in this directory. ;; This test prevents us declaring that XXX.el shadows ;; XXX.elc (or vice-versa) when they are in the same directory. diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 702e8d880b..e81a8b3798 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -915,7 +915,7 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'. ;; anything else than this trigger char, lest we'd blink ;; both when inserting the trigger char and when ;; inserting a subsequent trigger char like SPC. - (or (eq (point) pos) + (or (eq (char-before) last-command-event) (not (memq (char-before) smie-blink-matching-triggers))) (or smie-blink-matching-inners @@ -998,7 +998,10 @@ the beginning of a line." (unless (numberp (cadr (assoc tok smie-grammar))) (goto-char pos)) (setq smie--parent - (smie-backward-sexp 'halfsexp)))))) + (or (smie-backward-sexp 'halfsexp) + (let (res) + (while (null (setq res (smie-backward-sexp)))) + (list nil (point) (nth 2 res))))))))) (defun smie-rule-parent-p (&rest parents) "Return non-nil if the current token's parent is among PARENTS. @@ -1403,6 +1406,10 @@ should not be computed on the basis of the following token." (and (nth 4 (syntax-ppss)) 'noindent)) +(defun smie-indent-inside-string () + (and (nth 3 (syntax-ppss)) + 'noindent)) + (defun smie-indent-after-keyword () ;; Indentation right after a special keyword. (save-excursion @@ -1476,8 +1483,9 @@ should not be computed on the basis of the following token." (defvar smie-indent-functions '(smie-indent-fixindent smie-indent-bob smie-indent-close - smie-indent-comment smie-indent-comment-continue smie-indent-comment-close - smie-indent-comment-inside smie-indent-keyword smie-indent-after-keyword + smie-indent-comment smie-indent-comment-continue smie-indent-comment-close + smie-indent-comment-inside smie-indent-inside-string + smie-indent-keyword smie-indent-after-keyword smie-indent-exps) "Functions to compute the indentation. Each function is called with no argument, shouldn't move point, and should diff --git a/lisp/emulation/pc-select.el b/lisp/emulation/pc-select.el deleted file mode 100644 index 76562dd75c..0000000000 --- a/lisp/emulation/pc-select.el +++ /dev/null @@ -1,985 +0,0 @@ -;;; pc-select.el --- emulate mark, cut, copy and paste from Motif -;;; (or MAC GUI or MS-windoze (bah)) look-and-feel -;;; including key bindings. - -;; Copyright (C) 1995-1997, 2000-2011 Free Software Foundation, Inc. - -;; Author: Michael Staats <[email protected]> -;; Keywords: convenience emulations -;; Created: 26 Sep 1995 - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This package emulates the mark, copy, cut and paste look-and-feel of motif -;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows). -;; It modifies the keybindings of the cursor keys and the next, prior, -;; home and end keys. They will modify mark-active. -;; You can still get the old behavior of cursor moving with the -;; control sequences C-f, C-b, etc. -;; This package uses transient-mark-mode and -;; delete-selection-mode. -;; -;; In addition to that all key-bindings from the pc-mode are -;; done here too (as suggested by RMS). -;; -;; As I found out after I finished the first version, s-region.el tries -;; to do the same.... But my code is a little more complete and using -;; delete-selection-mode is very important for the look-and-feel. -;; Pete Forman <[email protected]> provided some motif -;; compliant keybindings which I added. I had to modify them a little -;; to add the -mark and -nomark functionality of cursor moving. -;; -;; Credits: -;; Many thanks to all who made comments. -;; Thanks to RMS and Ralf Muschall <[email protected]> for criticism. -;; Kevin Cutts <[email protected]> added the beginning-of-buffer -;; and end-of-buffer functions which I modified a little. -;; David Biesack <[email protected]> suggested some more cleanup. -;; Thanks to Pete Forman <[email protected]> -;; for additional motif keybindings. -;; Thanks to [email protected] (Johan Vromans) for a bug report -;; concerning setting of this-command. -;; Dan Nicolaescu <[email protected]> suggested suppressing the -;; scroll-up/scroll-down error. -;; Eli Barzilay ([email protected]) suggested the sexps functions and -;; keybindings. -;; -;; Ok, some details about the idea of PC Selection mode: -;; -;; o The standard keys for moving around (right, left, up, down, home, end, -;; prior, next, called "move-keys" from now on) will always de-activate -;; the mark. -;; o If you press "Shift" together with the "move-keys", the region -;; you pass along is activated -;; o You have the copy, cut and paste functions (as in many other programs) -;; which will operate on the active region -;; It was not possible to bind them to C-v, C-x and C-c for obvious -;; emacs reasons. -;; They will be bound according to the "old" behavior to S-delete (cut), -;; S-insert (paste) and C-insert (copy). These keys do the same in many -;; other programs. -;; - -;;; Code: - -;; Customization: -(defgroup pc-select nil - "Emulate pc bindings." - :prefix "pc-select" - :group 'emulations) - -(defcustom pc-select-override-scroll-error t - "Non-nil means don't generate error on scrolling past edge of buffer. -This variable applies in PC Selection mode only. -The scroll commands normally generate an error if you try to scroll -past the top or bottom of the buffer. This is annoying when selecting -text with these commands. If you set this variable to non-nil, these -errors are suppressed." - :type 'boolean - :group 'pc-select) -(define-obsolete-variable-alias 'pc-select-override-scroll-error - 'scroll-error-top-bottom - "24.1") - -(defcustom pc-select-selection-keys-only nil - "Non-nil means only bind the basic selection keys when started. -Other keys that emulate pc-behavior will be untouched. -This gives mostly Emacs-like behavior with only the selection keys enabled." - :type 'boolean - :group 'pc-select) - -(defcustom pc-select-meta-moves-sexps nil - "Non-nil means move sexp-wise with Meta key, otherwise move word-wise." - :type 'boolean - :group 'pc-select) - -(defcustom pc-selection-mode-hook nil - "The hook to run when PC Selection mode is toggled." - :type 'hook - :group 'pc-select) - -(defvar pc-select-saved-settings-alist nil - "The values of the variables before PC Selection mode was toggled on. -When PC Selection mode is toggled on, it sets quite a few variables -for its own purposes. This alist holds the original values of the -variables PC Selection mode had set, so that these variables can be -restored to their original values when PC Selection mode is toggled off.") - -(defvar pc-select-map nil - "The keymap used as the global map when PC Selection mode is on." ) - -(defvar pc-select-saved-global-map nil - "The global map that was in effect when PC Selection mode was toggled on.") - -(defvar pc-select-key-bindings-alist nil - "This alist holds all the key bindings PC Selection mode sets.") - -(defvar pc-select-default-key-bindings nil - "These key bindings always get set by PC Selection mode.") - -(unless pc-select-default-key-bindings - (let ((lst - ;; This is to avoid confusion with the delete-selection-mode. - ;; On simple displays you can't see that a region is active and - ;; will be deleted on the next keypress IMHO especially for - ;; copy-region-as-kill this is confusing. - ;; The same goes for exchange-point-and-mark - '(("\M-w" . copy-region-as-kill-nomark) - ("\C-x\C-x" . exchange-point-and-mark-nomark) - ([S-right] . forward-char-mark) - ([right] . forward-char-nomark) - ([C-S-right] . forward-word-mark) - ([C-right] . forward-word-nomark) - ([S-left] . backward-char-mark) - ([left] . backward-char-nomark) - ([C-S-left] . backward-word-mark) - ([C-left] . backward-word-nomark) - ([S-down] . next-line-mark) - ([down] . next-line-nomark) - - ([S-end] . end-of-line-mark) - ([end] . end-of-line-nomark) - ([S-C-end] . end-of-buffer-mark) - ([C-end] . end-of-buffer-nomark) - ([S-M-end] . end-of-buffer-mark) - ([M-end] . end-of-buffer-nomark) - - ([S-next] . scroll-up-mark) - ([next] . scroll-up-nomark) - - ([S-up] . previous-line-mark) - ([up] . previous-line-nomark) - - ([S-home] . beginning-of-line-mark) - ([home] . beginning-of-line-nomark) - ([S-C-home] . beginning-of-buffer-mark) - ([C-home] . beginning-of-buffer-nomark) - ([S-M-home] . beginning-of-buffer-mark) - ([M-home] . beginning-of-buffer-nomark) - - ([M-S-down] . forward-line-mark) - ([M-down] . forward-line-nomark) - ([M-S-up] . backward-line-mark) - ([M-up] . backward-line-nomark) - - ([S-prior] . scroll-down-mark) - ([prior] . scroll-down-nomark) - - ;; Next four lines are from Pete Forman. - ([C-down] . forward-paragraph-nomark) ; KNextPara cDn - ([C-up] . backward-paragraph-nomark) ; KPrevPara cUp - ([S-C-down] . forward-paragraph-mark) - ([S-C-up] . backward-paragraph-mark)))) - - (setq pc-select-default-key-bindings lst))) - -(defvar pc-select-extra-key-bindings nil - "Key bindings to set only if `pc-select-selection-keys-only' is nil.") - -;; The following keybindings are for standard ISO keyboards -;; as they are used with IBM compatible PCs, IBM RS/6000, -;; MACs, many X-Stations and probably more -(unless pc-select-extra-key-bindings - (let ((lst - '(([S-insert] . yank) - ([C-insert] . copy-region-as-kill) - ([S-delete] . kill-region) - - ;; The following bindings are useful on Sun Type 3 keyboards - ;; They implement the Get-Delete-Put (copy-cut-paste) - ;; functions from sunview on the L6, L8 and L10 keys - ;; Sam Steingold <[email protected]> says that f16 is copy and f18 is paste. - ([f16] . copy-region-as-kill) - ([f18] . yank) - ([f20] . kill-region) - - ;; The following bindings are from Pete Forman. - ([f6] . other-window) ; KNextPane F6 - ([C-delete] . kill-line) ; KEraseEndLine cDel - ("\M-\d" . undo) ; KUndo aBS - - ;; The following binding is taken from pc-mode.el - ;; as suggested by RMS. - ;; I only used the one that is not covered above. - ([C-M-delete] . kill-sexp) - ;; Next line proposed by Eli Barzilay - ([C-escape] . electric-buffer-list)))) - - (setq pc-select-extra-key-bindings lst))) - -(defvar pc-select-meta-moves-sexps-key-bindings - '((([M-S-right] . forward-sexp-mark) - ([M-right] . forward-sexp-nomark) - ([M-S-left] . backward-sexp-mark) - ([M-left] . backward-sexp-nomark)) - (([M-S-right] . forward-word-mark) - ([M-right] . forward-word-nomark) - ([M-S-left] . backward-word-mark) - ([M-left] . backward-word-nomark))) - "The list of key bindings controlled by `pc-select-meta-moves-sexp'. -The bindings in the car of this list get installed if -`pc-select-meta-moves-sexp' is t, the bindings in the cadr of this -list get installed otherwise.") - -;; This is for tty. We don't turn on normal-erase-is-backspace, -;; but bind keys as pc-selection-mode did before -;; normal-erase-is-backspace was invented, to keep us back -;; compatible. -(defvar pc-select-tty-key-bindings - '(([delete] . delete-char) ; KDelete Del - ([C-backspace] . backward-kill-word)) - "The list of key bindings controlled by `pc-select-selection-keys-only'. -These key bindings get installed when running in a tty, but only if -`pc-select-selection-keys-only' is nil.") - -(defvar pc-select-old-M-delete-binding nil - "Holds the old mapping of [M-delete] in the `function-key-map'. -This variable holds the value associated with [M-delete] in the -`function-key-map' before PC Selection mode had changed that -association.") - -;;;; -;; misc -;;;; - -(provide 'pc-select) - -(defun copy-region-as-kill-nomark (beg end) - "Save the region as if killed, but don't kill it; deactivate mark. -If `interprogram-cut-function' is non-nil, also save the text for a window -system cut and paste. - -Deactivating mark is to avoid confusion with `delete-selection-mode' -and `transient-mark-mode'." - (interactive "r") - (copy-region-as-kill beg end) - (setq mark-active nil) - (message "Region saved")) - -(defun exchange-point-and-mark-nomark () - "Like `exchange-point-and-mark' but without activating the mark." - (interactive) - (exchange-point-and-mark) - (setq mark-active nil)) - -;;;; -;; non-interactive -;;;; -(defun pc-select-ensure-mark () - ;; make sure mark is active - ;; test if it is active, if it isn't, set it and activate it - (or mark-active (set-mark-command nil)) - ;; Remember who activated the mark. - (setq mark-active 'pc-select)) - -(defun pc-select-maybe-deactivate-mark () - ;; maybe switch off mark (only if *we* switched it on) - (when (eq mark-active 'pc-select) - (deactivate-mark))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;;; forward and mark -;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun forward-char-mark (&optional arg) - "Ensure mark is active; move point right ARG characters (left if ARG negative). -On reaching end of buffer, stop and signal error." - (interactive "p") - (pc-select-ensure-mark) - (forward-char arg)) - -(defun forward-word-mark (&optional arg) - "Ensure mark is active; move point right ARG words (backward if ARG is negative). -Normally returns t. -If an edge of the buffer is reached, point is left there -and nil is returned." - (interactive "p") - (pc-select-ensure-mark) - (forward-word arg)) - -(defun forward-line-mark (&optional arg) - "Ensure mark is active; move cursor vertically down ARG lines." - (interactive "p") - (pc-select-ensure-mark) - (forward-line arg) - (setq this-command 'forward-line) -) - -(defun forward-sexp-mark (&optional arg) - "Ensure mark is active; move forward across one balanced expression (sexp). -With argument, do it that many times. Negative arg -N means -move backward across N balanced expressions." - (interactive "p") - (pc-select-ensure-mark) - (forward-sexp arg)) - -(defun forward-paragraph-mark (&optional arg) - "Ensure mark is active; move forward to end of paragraph. -With arg N, do it N times; negative arg -N means move backward N paragraphs. - -A line which `paragraph-start' matches either separates paragraphs -\(if `paragraph-separate' matches it also) or is the first line of a paragraph. -A paragraph end is the beginning of a line which is not part of the paragraph -to which the end of the previous line belongs, or the end of the buffer." - (interactive "p") - (pc-select-ensure-mark) - (forward-paragraph arg)) - -(defun next-line-mark (&optional arg) - "Ensure mark is active; move cursor vertically down ARG lines. -If there is no character in the target line exactly under the current column, -the cursor is positioned after the character in that line which spans this -column, or at the end of the line if it is not long enough. -If there is no line in the buffer after this one, behavior depends on the -value of `next-line-add-newlines'. If non-nil, it inserts a newline character -to create a line, and moves the cursor to that line. Otherwise it moves the -cursor to the end of the buffer \(if already at the end of the buffer, an error -is signaled). - -The command \\[set-goal-column] can be used to create -a semipermanent goal column to which this command always moves. -Then it does not try to move vertically. This goal column is stored -in `goal-column', which is nil when there is none." - (interactive "p") - (pc-select-ensure-mark) - (with-no-warnings (next-line arg)) - (setq this-command 'next-line)) - -(defun end-of-line-mark (&optional arg) - "Ensure mark is active; move point to end of current line. -With argument ARG not nil or 1, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "p") - (pc-select-ensure-mark) - (end-of-line arg) - (setq this-command 'end-of-line)) - -(defun backward-line-mark (&optional arg) - "Ensure mark is active; move cursor vertically up ARG lines." - (interactive "p") - (pc-select-ensure-mark) - (if (null arg) - (setq arg 1)) - (forward-line (- arg)) - (setq this-command 'forward-line) -) - -(defun scroll-down-mark (&optional arg) - "Ensure mark is active; scroll down ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll upward. -When calling from a program, supply a number as argument or nil. -Attempting to scroll past the edge of buffer does not raise an -error, unless `pc-select-override-scroll-error' is nil." - (interactive "P") - (pc-select-ensure-mark) - (cond (pc-select-override-scroll-error - (condition-case nil (scroll-down arg) - (beginning-of-buffer (goto-char (point-min))))) - (t (scroll-down arg)))) - -(defun end-of-buffer-mark (&optional arg) - "Ensure mark is active; move point to the end of the buffer. -With arg N, put point N/10 of the way from the end. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. - -Don't use this command in Lisp programs! -\(goto-char \(point-max)) is faster and avoids clobbering the mark." - (interactive "P") - (pc-select-ensure-mark) - (let ((size (- (point-max) (point-min)))) - (goto-char (if arg - (- (point-max) - (if (> size 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ size 10)) - (/ (* size (prefix-numeric-value arg)) 10))) - (point-max)))) - ;; If we went to a place in the middle of the buffer, - ;; adjust it to the beginning of a line. - (if arg (forward-line 1) - ;; If the end of the buffer is not already on the screen, - ;; then scroll specially to put it near, but not at, the bottom. - (if (let ((old-point (point))) - (save-excursion - (goto-char (window-start)) - (vertical-motion (window-height)) - (< (point) old-point))) - (progn - (overlay-recenter (point)) - (recenter -3))))) - -;;;;;;;;; -;;;;; no mark -;;;;;;;;; - -(defun forward-char-nomark (&optional arg) - "Deactivate mark; move point right ARG characters \(left if ARG negative). -On reaching end of buffer, stop and signal error." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (forward-char arg)) - -(defun forward-word-nomark (&optional arg) - "Deactivate mark; move point right ARG words \(backward if ARG is negative). -Normally returns t. -If an edge of the buffer is reached, point is left there -and nil is returned." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (forward-word arg)) - -(defun forward-line-nomark (&optional arg) - "Deactivate mark; move cursor vertically down ARG lines." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (forward-line arg) - (setq this-command 'forward-line) -) - -(defun forward-sexp-nomark (&optional arg) - "Deactivate mark; move forward across one balanced expression (sexp). -With argument, do it that many times. Negative arg -N means -move backward across N balanced expressions." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (forward-sexp arg)) - -(defun forward-paragraph-nomark (&optional arg) - "Deactivate mark; move forward to end of paragraph. -With arg N, do it N times; negative arg -N means move backward N paragraphs. - -A line which `paragraph-start' matches either separates paragraphs -\(if `paragraph-separate' matches it also) or is the first line of a paragraph. -A paragraph end is the beginning of a line which is not part of the paragraph -to which the end of the previous line belongs, or the end of the buffer." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (forward-paragraph arg)) - -(defun next-line-nomark (&optional arg) - "Deactivate mark; move cursor vertically down ARG lines. -If there is no character in the target line exactly under the current column, -the cursor is positioned after the character in that line which spans this -column, or at the end of the line if it is not long enough. -If there is no line in the buffer after this one, behavior depends on the -value of `next-line-add-newlines'. If non-nil, it inserts a newline character -to create a line, and moves the cursor to that line. Otherwise it moves the -cursor to the end of the buffer (if already at the end of the buffer, an error -is signaled). - -The command \\[set-goal-column] can be used to create -a semipermanent goal column to which this command always moves. -Then it does not try to move vertically. This goal column is stored -in `goal-column', which is nil when there is none." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (with-no-warnings (next-line arg)) - (setq this-command 'next-line)) - -(defun end-of-line-nomark (&optional arg) - "Deactivate mark; move point to end of current line. -With argument ARG not nil or 1, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (end-of-line arg) - (setq this-command 'end-of-line)) - -(defun backward-line-nomark (&optional arg) - "Deactivate mark; move cursor vertically up ARG lines." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (if (null arg) - (setq arg 1)) - (forward-line (- arg)) - (setq this-command 'forward-line) -) - -(defun scroll-down-nomark (&optional arg) - "Deactivate mark; scroll down ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll upward. -When calling from a program, supply a number as argument or nil. -Attempting to scroll past the edge of buffer does not raise an -error, unless `pc-select-override-scroll-error' is nil." - (interactive "P") - (pc-select-maybe-deactivate-mark) - (cond (pc-select-override-scroll-error - (condition-case nil (scroll-down arg) - (beginning-of-buffer (goto-char (point-min))))) - (t (scroll-down arg)))) - -(defun end-of-buffer-nomark (&optional arg) - "Deactivate mark; move point to the end of the buffer. -With arg N, put point N/10 of the way from the end. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. - -Don't use this command in Lisp programs! -\(goto-char (point-max)) is faster and avoids clobbering the mark." - (interactive "P") - (pc-select-maybe-deactivate-mark) - (let ((size (- (point-max) (point-min)))) - (goto-char (if arg - (- (point-max) - (if (> size 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ size 10)) - (/ (* size (prefix-numeric-value arg)) 10))) - (point-max)))) - ;; If we went to a place in the middle of the buffer, - ;; adjust it to the beginning of a line. - (if arg (forward-line 1) - ;; If the end of the buffer is not already on the screen, - ;; then scroll specially to put it near, but not at, the bottom. - (if (let ((old-point (point))) - (save-excursion - (goto-char (window-start)) - (vertical-motion (window-height)) - (< (point) old-point))) - (progn - (overlay-recenter (point)) - (recenter -3))))) - - -;;;;;;;;;;;;;;;;;;;; -;;;;;; backwards and mark -;;;;;;;;;;;;;;;;;;;; - -(defun backward-char-mark (&optional arg) - "Ensure mark is active; move point left ARG characters (right if ARG negative). -On attempt to pass beginning or end of buffer, stop and signal error." - (interactive "p") - (pc-select-ensure-mark) - (backward-char arg)) - -(defun backward-word-mark (&optional arg) - "Ensure mark is active; move backward until encountering the end of a word. -With argument, do this that many times." - (interactive "p") - (pc-select-ensure-mark) - (backward-word arg)) - -(defun backward-sexp-mark (&optional arg) - "Ensure mark is active; move backward across one balanced expression (sexp). -With argument, do it that many times. Negative arg -N means -move forward across N balanced expressions." - (interactive "p") - (pc-select-ensure-mark) - (backward-sexp arg)) - -(defun backward-paragraph-mark (&optional arg) - "Ensure mark is active; move backward to start of paragraph. -With arg N, do it N times; negative arg -N means move forward N paragraphs. - -A paragraph start is the beginning of a line which is a -`first-line-of-paragraph' or which is ordinary text and follows a -paragraph-separating line; except: if the first real line of a -paragraph is preceded by a blank line, the paragraph starts at that -blank line. - -See `forward-paragraph' for more information." - (interactive "p") - (pc-select-ensure-mark) - (backward-paragraph arg)) - -(defun previous-line-mark (&optional arg) - "Ensure mark is active; move cursor vertically up ARG lines. -If there is no character in the target line exactly over the current column, -the cursor is positioned after the character in that line which spans this -column, or at the end of the line if it is not long enough. - -The command \\[set-goal-column] can be used to create -a semipermanent goal column to which this command always moves. -Then it does not try to move vertically. - -If you are thinking of using this in a Lisp program, consider using -`forward-line' with a negative argument instead. It is usually easier -to use and more reliable (no dependence on goal column, etc.)." - (interactive "p") - (pc-select-ensure-mark) - (with-no-warnings (previous-line arg)) - (setq this-command 'previous-line)) - -(defun beginning-of-line-mark (&optional arg) - "Ensure mark is active; move point to beginning of current line. -With argument ARG not nil or 1, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "p") - (pc-select-ensure-mark) - (beginning-of-line arg)) - - -(defun scroll-up-mark (&optional arg) - "Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll downward. -When calling from a program, supply a number as argument or nil. -Attempting to scroll past the edge of buffer does not raise an -error, unless `pc-select-override-scroll-error' is nil." - (interactive "P") - (pc-select-ensure-mark) - (cond (pc-select-override-scroll-error - (condition-case nil (scroll-up arg) - (end-of-buffer (goto-char (point-max))))) - (t (scroll-up arg)))) - -(defun beginning-of-buffer-mark (&optional arg) - "Ensure mark is active; move point to the beginning of the buffer. -With arg N, put point N/10 of the way from the beginning. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. - -Don't use this command in Lisp programs! -\(goto-char (point-min)) is faster and avoids clobbering the mark." - (interactive "P") - (pc-select-ensure-mark) - (let ((size (- (point-max) (point-min)))) - (goto-char (if arg - (+ (point-min) - (if (> size 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ size 10)) - (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) - (point-min)))) - (if arg (forward-line 1))) - -;;;;;;;; -;;; no mark -;;;;;;;; - -(defun backward-char-nomark (&optional arg) - "Deactivate mark; move point left ARG characters (right if ARG negative). -On attempt to pass beginning or end of buffer, stop and signal error." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (backward-char arg)) - -(defun backward-word-nomark (&optional arg) - "Deactivate mark; move backward until encountering the end of a word. -With argument, do this that many times." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (backward-word arg)) - -(defun backward-sexp-nomark (&optional arg) - "Deactivate mark; move backward across one balanced expression (sexp). -With argument, do it that many times. Negative arg -N means -move forward across N balanced expressions." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (backward-sexp arg)) - -(defun backward-paragraph-nomark (&optional arg) - "Deactivate mark; move backward to start of paragraph. -With arg N, do it N times; negative arg -N means move forward N paragraphs. - -A paragraph start is the beginning of a line which is a -`first-line-of-paragraph' or which is ordinary text and follows a -paragraph-separating line; except: if the first real line of a -paragraph is preceded by a blank line, the paragraph starts at that -blank line. - -See `forward-paragraph' for more information." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (backward-paragraph arg)) - -(defun previous-line-nomark (&optional arg) - "Deactivate mark; move cursor vertically up ARG lines. -If there is no character in the target line exactly over the current column, -the cursor is positioned after the character in that line which spans this -column, or at the end of the line if it is not long enough. - -The command \\[set-goal-column] can be used to create -a semipermanent goal column to which this command always moves. -Then it does not try to move vertically." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (with-no-warnings (previous-line arg)) - (setq this-command 'previous-line)) - -(defun beginning-of-line-nomark (&optional arg) - "Deactivate mark; move point to beginning of current line. -With argument ARG not nil or 1, move forward ARG - 1 lines first. -If scan reaches end of buffer, stop there without error." - (interactive "p") - (pc-select-maybe-deactivate-mark) - (beginning-of-line arg)) - -(defun scroll-up-nomark (&optional arg) - "Deactivate mark; scroll upward ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll downward. -When calling from a program, supply a number as argument or nil. -Attempting to scroll past the edge of buffer does not raise an -error, unless `pc-select-override-scroll-error' is nil." - (interactive "P") - (pc-select-maybe-deactivate-mark) - (cond (pc-select-override-scroll-error - (condition-case nil (scroll-up arg) - (end-of-buffer (goto-char (point-max))))) - (t (scroll-up arg)))) - -(defun beginning-of-buffer-nomark (&optional arg) - "Deactivate mark; move point to the beginning of the buffer. -With arg N, put point N/10 of the way from the beginning. - -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. - -Don't use this command in Lisp programs! -\(goto-char (point-min)) is faster and avoids clobbering the mark." - (interactive "P") - (pc-select-maybe-deactivate-mark) - (let ((size (- (point-max) (point-min)))) - (goto-char (if arg - (+ (point-min) - (if (> size 10000) - ;; Avoid overflow for large buffer sizes! - (* (prefix-numeric-value arg) - (/ size 10)) - (/ (+ 10 (* size (prefix-numeric-value arg))) 10))) - (point-min)))) - (if arg (forward-line 1))) - - -(defun pc-select-define-keys (alist keymap) - "Make KEYMAP have the key bindings specified in ALIST." - (let ((lst alist)) - (while lst - (define-key keymap (caar lst) (cdar lst)) - (setq lst (cdr lst))))) - -(defun pc-select-restore-keys (alist keymap saved-map) - "Use ALIST to restore key bindings from SAVED-MAP into KEYMAP. -Go through all the key bindings in ALIST, and, for each key -binding, if KEYMAP and ALIST still agree on the key binding, -restore the previous value of that key binding from SAVED-MAP." - (let ((lst alist)) - (while lst - (when (equal (lookup-key keymap (caar lst)) (cdar lst)) - (define-key keymap (caar lst) (lookup-key saved-map (caar lst)))) - (setq lst (cdr lst))))) - -(defmacro pc-select-add-to-alist (alist var val) - "Ensure that ALIST contains the cons cell (VAR . VAL). -If a cons cell whose car is VAR is already on the ALIST, update the -cdr of that cell with VAL. Otherwise, make a new cons cell -\(VAR . VAL), and prepend it onto ALIST." - (let ((elt (make-symbol "elt"))) - `(let ((,elt (assq ',var ,alist))) - (if ,elt - (setcdr ,elt ,val) - (setq ,alist (cons (cons ',var ,val) ,alist)))))) - -(defmacro pc-select-save-and-set-var (var newval) - "Set VAR to NEWVAL; save the old value. -The old value is saved on the `pc-select-saved-settings-alist'." - `(when (boundp ',var) - (pc-select-add-to-alist pc-select-saved-settings-alist ,var ,var) - (setq ,var ,newval))) - -(defmacro pc-select-save-and-set-mode (mode &optional arg mode-var) - "Call the function MODE; save the old value of the variable MODE. -MODE is presumed to be a function which turns on a minor mode. First, -save the value of the variable MODE on `pc-select-saved-settings-alist'. -Then, if ARG is specified, call MODE with ARG, otherwise call it with -nil as an argument. If MODE-VAR is specified, save the value of the -variable MODE-VAR (instead of the value of the variable MODE) on -`pc-select-saved-settings-alist'." - (unless mode-var (setq mode-var mode)) - `(when (fboundp ',mode) - (pc-select-add-to-alist pc-select-saved-settings-alist - ,mode-var ,mode-var) - (,mode ,arg))) - -(defmacro pc-select-restore-var (var) - "Restore the previous value of the variable VAR. -Look up VAR's previous value in `pc-select-saved-settings-alist', and, -if the value is found, set VAR to that value." - (let ((elt (make-symbol "elt"))) - `(let ((,elt (assq ',var pc-select-saved-settings-alist))) - (unless (null ,elt) - (setq ,var (cdr ,elt)))))) - -(defmacro pc-select-restore-mode (mode) - "Restore the previous state (either on or off) of the minor mode MODE. -Look up the value of the variable MODE on `pc-select-saved-settings-alist'. -If the value is non-nil, call the function MODE with an argument of -1, otherwise call it with an argument of -1." - (let ((elt (make-symbol "elt"))) - `(when (fboundp ',mode) - (let ((,elt (assq ',mode pc-select-saved-settings-alist))) - (unless (null ,elt) - (,mode (if (cdr ,elt) 1 -1))))))) - - -;;;###autoload -(define-minor-mode pc-selection-mode - "Change mark behavior to emulate Motif, Mac or MS-Windows cut and paste style. - -This mode enables Delete Selection mode and Transient Mark mode. - -The arrow keys (and others) are bound to new functions -which modify the status of the mark. - -The ordinary arrow keys disable the mark. -The shift-arrow keys move, leaving the mark behind. - -C-LEFT and C-RIGHT move back or forward one word, disabling the mark. -S-C-LEFT and S-C-RIGHT move back or forward one word, leaving the mark behind. - -M-LEFT and M-RIGHT move back or forward one word or sexp, disabling the mark. -S-M-LEFT and S-M-RIGHT move back or forward one word or sexp, leaving the mark -behind. To control whether these keys move word-wise or sexp-wise set the -variable `pc-select-meta-moves-sexps' after loading pc-select.el but before -turning PC Selection mode on. - -C-DOWN and C-UP move back or forward a paragraph, disabling the mark. -S-C-DOWN and S-C-UP move back or forward a paragraph, leaving the mark behind. - -HOME moves to beginning of line, disabling the mark. -S-HOME moves to beginning of line, leaving the mark behind. -With Ctrl or Meta, these keys move to beginning of buffer instead. - -END moves to end of line, disabling the mark. -S-END moves to end of line, leaving the mark behind. -With Ctrl or Meta, these keys move to end of buffer instead. - -PRIOR or PAGE-UP scrolls and disables the mark. -S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind. - -S-DELETE kills the region (`kill-region'). -S-INSERT yanks text from the kill ring (`yank'). -C-INSERT copies the region into the kill ring (`copy-region-as-kill'). - -In addition, certain other PC bindings are imitated (to avoid this, set -the variable `pc-select-selection-keys-only' to t after loading pc-select.el -but before calling PC Selection mode): - - F6 other-window - DELETE delete-char - C-DELETE kill-line - M-DELETE kill-word - C-M-DELETE kill-sexp - C-BACKSPACE backward-kill-word - M-BACKSPACE undo" - ;; FIXME: bring pc-bindings-mode here ? - nil nil nil - - :group 'pc-select - :global t - - (if pc-selection-mode - (if (null pc-select-key-bindings-alist) - (progn - (setq pc-select-saved-global-map (copy-keymap (current-global-map))) - (setq pc-select-key-bindings-alist - (append pc-select-default-key-bindings - (if pc-select-selection-keys-only - nil - pc-select-extra-key-bindings) - (if pc-select-meta-moves-sexps - (car pc-select-meta-moves-sexps-key-bindings) - (cadr pc-select-meta-moves-sexps-key-bindings)) - (if (or pc-select-selection-keys-only - (eq window-system 'x) - (memq system-name '(ms-dos windows-nt))) - nil - pc-select-tty-key-bindings))) - - (pc-select-define-keys pc-select-key-bindings-alist - (current-global-map)) - - (unless (or pc-select-selection-keys-only - (eq window-system 'x) - (memq system-name '(ms-dos windows-nt))) - ;; it is not clear that we need the following line - ;; I hope it doesn't do too much harm to leave it in, though... - (setq pc-select-old-M-delete-binding - (lookup-key function-key-map [M-delete])) - (define-key function-key-map [M-delete] [?\M-d])) - - (when (and (not pc-select-selection-keys-only) - (or (eq window-system 'x) - (memq system-name '(ms-dos windows-nt))) - (fboundp 'normal-erase-is-backspace-mode)) - (pc-select-save-and-set-mode normal-erase-is-backspace-mode 1 - normal-erase-is-backspace)) - ;; the original author also had this above: - ;; (setq-default normal-erase-is-backspace t) - ;; However, the documentation for the variable says that - ;; "setting it with setq has no effect", so I'm removing it. - - (pc-select-save-and-set-var highlight-nonselected-windows nil) - (pc-select-save-and-set-var transient-mark-mode t) - (pc-select-save-and-set-var mark-even-if-inactive t) - (pc-select-save-and-set-mode delete-selection-mode 1)) - ;;else - ;; If the user turned on pc-selection-mode a second time - ;; do not clobber the values of the variables that were - ;; saved from before pc-selection mode was activated -- - ;; just make sure the values are the way we like them. - (pc-select-define-keys pc-select-key-bindings-alist - (current-global-map)) - (unless (or pc-select-selection-keys-only - (eq window-system 'x) - (memq system-name '(ms-dos windows-nt))) - ;; it is not clear that we need the following line - ;; I hope it doesn't do too much harm to leave it in, though... - (define-key function-key-map [M-delete] [?\M-d])) - (when (and (not pc-select-selection-keys-only) - (or (eq window-system 'x) - (memq system-name '(ms-dos windows-nt))) - (fboundp 'normal-erase-is-backspace-mode)) - (normal-erase-is-backspace-mode 1)) - (setq highlight-nonselected-windows nil) - (setq transient-mark-mode t) - (setq mark-even-if-inactive t) - (delete-selection-mode 1)) - ;;else - (when pc-select-key-bindings-alist - (when (and (not pc-select-selection-keys-only) - (or (eq window-system 'x) - (memq system-name '(ms-dos windows-nt)))) - (pc-select-restore-mode normal-erase-is-backspace-mode)) - - (pc-select-restore-keys - pc-select-key-bindings-alist (current-global-map) - pc-select-saved-global-map) - - (pc-select-restore-var highlight-nonselected-windows) - (pc-select-restore-var transient-mark-mode) - (pc-select-restore-var mark-even-if-inactive) - (pc-select-restore-mode delete-selection-mode) - (and pc-select-old-M-delete-binding - (define-key function-key-map [M-delete] - pc-select-old-M-delete-binding)) - (setq pc-select-key-bindings-alist nil - pc-select-saved-settings-alist nil)))) - -;;; pc-select.el ends here diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el index 328fbac903..6f4f0ce80e 100644 --- a/lisp/emulation/vip.el +++ b/lisp/emulation/vip.el @@ -164,132 +164,133 @@ If nil then it is bound to `delete-backward-char'." ;; key bindings -(defvar vip-mode-map (make-keymap)) - -(define-key vip-mode-map "\C-a" 'beginning-of-line) -(define-key vip-mode-map "\C-b" 'vip-scroll-back) -(define-key vip-mode-map "\C-c" 'vip-ctl-c) -(define-key vip-mode-map "\C-d" 'vip-scroll-up) -(define-key vip-mode-map "\C-e" 'vip-scroll-up-one) -(define-key vip-mode-map "\C-f" 'vip-scroll) -(define-key vip-mode-map "\C-g" 'vip-keyboard-quit) -(define-key vip-mode-map "\C-h" 'help-command) -(define-key vip-mode-map "\C-m" 'vip-scroll-back) -(define-key vip-mode-map "\C-n" 'vip-other-window) -(define-key vip-mode-map "\C-o" 'vip-open-line-at-point) -(define-key vip-mode-map "\C-u" 'vip-scroll-down) -(define-key vip-mode-map "\C-x" 'vip-ctl-x) -(define-key vip-mode-map "\C-y" 'vip-scroll-down-one) -(define-key vip-mode-map "\C-z" 'vip-change-mode-to-emacs) -(define-key vip-mode-map "\e" 'vip-ESC) - -(define-key vip-mode-map " " 'vip-scroll) -(define-key vip-mode-map "!" 'vip-command-argument) -(define-key vip-mode-map "\"" 'vip-command-argument) -(define-key vip-mode-map "#" 'vip-command-argument) -(define-key vip-mode-map "$" 'vip-goto-eol) -(define-key vip-mode-map "%" 'vip-paren-match) -(define-key vip-mode-map "&" 'vip-nil) -(define-key vip-mode-map "'" 'vip-goto-mark-and-skip-white) -(define-key vip-mode-map "(" 'vip-backward-sentence) -(define-key vip-mode-map ")" 'vip-forward-sentence) -(define-key vip-mode-map "*" 'call-last-kbd-macro) -(define-key vip-mode-map "+" 'vip-next-line-at-bol) -(define-key vip-mode-map "," 'vip-repeat-find-opposite) -(define-key vip-mode-map "-" 'vip-previous-line-at-bol) -(define-key vip-mode-map "." 'vip-repeat) -(define-key vip-mode-map "/" 'vip-search-forward) - -(define-key vip-mode-map "0" 'vip-beginning-of-line) -(define-key vip-mode-map "1" 'vip-digit-argument) -(define-key vip-mode-map "2" 'vip-digit-argument) -(define-key vip-mode-map "3" 'vip-digit-argument) -(define-key vip-mode-map "4" 'vip-digit-argument) -(define-key vip-mode-map "5" 'vip-digit-argument) -(define-key vip-mode-map "6" 'vip-digit-argument) -(define-key vip-mode-map "7" 'vip-digit-argument) -(define-key vip-mode-map "8" 'vip-digit-argument) -(define-key vip-mode-map "9" 'vip-digit-argument) - -(define-key vip-mode-map ":" 'vip-ex) -(define-key vip-mode-map ";" 'vip-repeat-find) -(define-key vip-mode-map "<" 'vip-command-argument) -(define-key vip-mode-map "=" 'vip-command-argument) -(define-key vip-mode-map ">" 'vip-command-argument) -(define-key vip-mode-map "?" 'vip-search-backward) -(define-key vip-mode-map "@" 'vip-nil) - -(define-key vip-mode-map "A" 'vip-Append) -(define-key vip-mode-map "B" 'vip-backward-Word) -(define-key vip-mode-map "C" 'vip-ctl-c-equivalent) -(define-key vip-mode-map "D" 'vip-kill-line) -(define-key vip-mode-map "E" 'vip-end-of-Word) -(define-key vip-mode-map "F" 'vip-find-char-backward) -(define-key vip-mode-map "G" 'vip-goto-line) -(define-key vip-mode-map "H" 'vip-window-top) -(define-key vip-mode-map "I" 'vip-Insert) -(define-key vip-mode-map "J" 'vip-join-lines) -(define-key vip-mode-map "K" 'vip-kill-buffer) -(define-key vip-mode-map "L" 'vip-window-bottom) -(define-key vip-mode-map "M" 'vip-window-middle) -(define-key vip-mode-map "N" 'vip-search-Next) -(define-key vip-mode-map "O" 'vip-Open-line) -(define-key vip-mode-map "P" 'vip-Put-back) -(define-key vip-mode-map "Q" 'vip-query-replace) -(define-key vip-mode-map "R" 'vip-replace-string) -(define-key vip-mode-map "S" 'vip-switch-to-buffer-other-window) -(define-key vip-mode-map "T" 'vip-goto-char-backward) -(define-key vip-mode-map "U" 'vip-nil) -(define-key vip-mode-map "V" 'vip-find-file-other-window) -(define-key vip-mode-map "W" 'vip-forward-Word) -(define-key vip-mode-map "X" 'vip-ctl-x-equivalent) -(define-key vip-mode-map "Y" 'vip-yank-line) -(define-key vip-mode-map "ZZ" 'save-buffers-kill-emacs) - -(define-key vip-mode-map "[" 'vip-nil) -(define-key vip-mode-map "\\" 'vip-escape-to-emacs) -(define-key vip-mode-map "]" 'vip-nil) -(define-key vip-mode-map "^" 'vip-bol-and-skip-white) -(define-key vip-mode-map "_" 'vip-nil) -(define-key vip-mode-map "`" 'vip-goto-mark) - -(define-key vip-mode-map "a" 'vip-append) -(define-key vip-mode-map "b" 'vip-backward-word) -(define-key vip-mode-map "c" 'vip-command-argument) -(define-key vip-mode-map "d" 'vip-command-argument) -(define-key vip-mode-map "e" 'vip-end-of-word) -(define-key vip-mode-map "f" 'vip-find-char-forward) -(define-key vip-mode-map "g" 'vip-info-on-file) -(define-key vip-mode-map "h" 'vip-backward-char) -(define-key vip-mode-map "i" 'vip-insert) -(define-key vip-mode-map "j" 'vip-next-line) -(define-key vip-mode-map "k" 'vip-previous-line) -(define-key vip-mode-map "l" 'vip-forward-char) -(define-key vip-mode-map "m" 'vip-mark-point) -(define-key vip-mode-map "n" 'vip-search-next) -(define-key vip-mode-map "o" 'vip-open-line) -(define-key vip-mode-map "p" 'vip-put-back) -(define-key vip-mode-map "q" 'vip-nil) -(define-key vip-mode-map "r" 'vip-replace-char) -(define-key vip-mode-map "s" 'vip-switch-to-buffer) -(define-key vip-mode-map "t" 'vip-goto-char-forward) -(define-key vip-mode-map "u" 'vip-undo) -(define-key vip-mode-map "v" 'vip-find-file) -(define-key vip-mode-map "w" 'vip-forward-word) -(define-key vip-mode-map "x" 'vip-delete-char) -(define-key vip-mode-map "y" 'vip-command-argument) -(define-key vip-mode-map "zH" 'vip-line-to-top) -(define-key vip-mode-map "zM" 'vip-line-to-middle) -(define-key vip-mode-map "zL" 'vip-line-to-bottom) -(define-key vip-mode-map "z\C-m" 'vip-line-to-top) -(define-key vip-mode-map "z." 'vip-line-to-middle) -(define-key vip-mode-map "z-" 'vip-line-to-bottom) - -(define-key vip-mode-map "{" 'vip-backward-paragraph) -(define-key vip-mode-map "|" 'vip-goto-col) -(define-key vip-mode-map "}" 'vip-forward-paragraph) -(define-key vip-mode-map "~" 'vip-nil) -(define-key vip-mode-map "\177" 'vip-delete-backward-char) +(defvar vip-mode-map + (let ((map (make-keymap))) + (define-key map "\C-a" 'beginning-of-line) + (define-key map "\C-b" 'vip-scroll-back) + (define-key map "\C-c" 'vip-ctl-c) + (define-key map "\C-d" 'vip-scroll-up) + (define-key map "\C-e" 'vip-scroll-up-one) + (define-key map "\C-f" 'vip-scroll) + (define-key map "\C-g" 'vip-keyboard-quit) + (define-key map "\C-h" 'help-command) + (define-key map "\C-m" 'vip-scroll-back) + (define-key map "\C-n" 'vip-other-window) + (define-key map "\C-o" 'vip-open-line-at-point) + (define-key map "\C-u" 'vip-scroll-down) + (define-key map "\C-x" 'vip-ctl-x) + (define-key map "\C-y" 'vip-scroll-down-one) + (define-key map "\C-z" 'vip-change-mode-to-emacs) + (define-key map "\e" 'vip-ESC) + + (define-key map " " 'vip-scroll) + (define-key map "!" 'vip-command-argument) + (define-key map "\"" 'vip-command-argument) + (define-key map "#" 'vip-command-argument) + (define-key map "$" 'vip-goto-eol) + (define-key map "%" 'vip-paren-match) + (define-key map "&" 'vip-nil) + (define-key map "'" 'vip-goto-mark-and-skip-white) + (define-key map "(" 'vip-backward-sentence) + (define-key map ")" 'vip-forward-sentence) + (define-key map "*" 'call-last-kbd-macro) + (define-key map "+" 'vip-next-line-at-bol) + (define-key map "," 'vip-repeat-find-opposite) + (define-key map "-" 'vip-previous-line-at-bol) + (define-key map "." 'vip-repeat) + (define-key map "/" 'vip-search-forward) + + (define-key map "0" 'vip-beginning-of-line) + (define-key map "1" 'vip-digit-argument) + (define-key map "2" 'vip-digit-argument) + (define-key map "3" 'vip-digit-argument) + (define-key map "4" 'vip-digit-argument) + (define-key map "5" 'vip-digit-argument) + (define-key map "6" 'vip-digit-argument) + (define-key map "7" 'vip-digit-argument) + (define-key map "8" 'vip-digit-argument) + (define-key map "9" 'vip-digit-argument) + + (define-key map ":" 'vip-ex) + (define-key map ";" 'vip-repeat-find) + (define-key map "<" 'vip-command-argument) + (define-key map "=" 'vip-command-argument) + (define-key map ">" 'vip-command-argument) + (define-key map "?" 'vip-search-backward) + (define-key map "@" 'vip-nil) + + (define-key map "A" 'vip-Append) + (define-key map "B" 'vip-backward-Word) + (define-key map "C" 'vip-ctl-c-equivalent) + (define-key map "D" 'vip-kill-line) + (define-key map "E" 'vip-end-of-Word) + (define-key map "F" 'vip-find-char-backward) + (define-key map "G" 'vip-goto-line) + (define-key map "H" 'vip-window-top) + (define-key map "I" 'vip-Insert) + (define-key map "J" 'vip-join-lines) + (define-key map "K" 'vip-kill-buffer) + (define-key map "L" 'vip-window-bottom) + (define-key map "M" 'vip-window-middle) + (define-key map "N" 'vip-search-Next) + (define-key map "O" 'vip-Open-line) + (define-key map "P" 'vip-Put-back) + (define-key map "Q" 'vip-query-replace) + (define-key map "R" 'vip-replace-string) + (define-key map "S" 'vip-switch-to-buffer-other-window) + (define-key map "T" 'vip-goto-char-backward) + (define-key map "U" 'vip-nil) + (define-key map "V" 'vip-find-file-other-window) + (define-key map "W" 'vip-forward-Word) + (define-key map "X" 'vip-ctl-x-equivalent) + (define-key map "Y" 'vip-yank-line) + (define-key map "ZZ" 'save-buffers-kill-emacs) + + (define-key map "[" 'vip-nil) + (define-key map "\\" 'vip-escape-to-emacs) + (define-key map "]" 'vip-nil) + (define-key map "^" 'vip-bol-and-skip-white) + (define-key map "_" 'vip-nil) + (define-key map "`" 'vip-goto-mark) + + (define-key map "a" 'vip-append) + (define-key map "b" 'vip-backward-word) + (define-key map "c" 'vip-command-argument) + (define-key map "d" 'vip-command-argument) + (define-key map "e" 'vip-end-of-word) + (define-key map "f" 'vip-find-char-forward) + (define-key map "g" 'vip-info-on-file) + (define-key map "h" 'vip-backward-char) + (define-key map "i" 'vip-insert) + (define-key map "j" 'vip-next-line) + (define-key map "k" 'vip-previous-line) + (define-key map "l" 'vip-forward-char) + (define-key map "m" 'vip-mark-point) + (define-key map "n" 'vip-search-next) + (define-key map "o" 'vip-open-line) + (define-key map "p" 'vip-put-back) + (define-key map "q" 'vip-nil) + (define-key map "r" 'vip-replace-char) + (define-key map "s" 'vip-switch-to-buffer) + (define-key map "t" 'vip-goto-char-forward) + (define-key map "u" 'vip-undo) + (define-key map "v" 'vip-find-file) + (define-key map "w" 'vip-forward-word) + (define-key map "x" 'vip-delete-char) + (define-key map "y" 'vip-command-argument) + (define-key map "zH" 'vip-line-to-top) + (define-key map "zM" 'vip-line-to-middle) + (define-key map "zL" 'vip-line-to-bottom) + (define-key map "z\C-m" 'vip-line-to-top) + (define-key map "z." 'vip-line-to-middle) + (define-key map "z-" 'vip-line-to-bottom) + + (define-key map "{" 'vip-backward-paragraph) + (define-key map "|" 'vip-goto-col) + (define-key map "}" 'vip-forward-paragraph) + (define-key map "~" 'vip-nil) + (define-key map "\177" 'vip-delete-backward-char) + map)) (defun vip-version () (interactive) diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 879dd22856..2996fee9bc 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,23 @@ +2011-02-10 Stefan Monnier <[email protected]> + + * erc-list.el (erc-list-menu-mode-map): Move initialization + into declaration. + +2011-02-07 Julien Danjou <[email protected]> + + * erc-track.el (erc-window-configuration-change): New function. + This will allow to track buffer visibility when a command is + finished to executed. Idea stolen from rcirc. + (track): Put erc-window-configuration-change in + window-configuration-change-hook. + (erc-modified-channels-update): Remove + erc-modified-channels-update from post-command-hook after update. + +2011-01-31 Antoine Levitt <[email protected]> (tiny change) + + * erc-track.el (track): Don't reset erc-modified-channels-object + each time erc-track-mode is activated. + 2011-01-13 Stefan Monnier <[email protected]> * erc.el (erc-mode): diff --git a/lisp/erc/erc-list.el b/lisp/erc/erc-list.el index 955b654f92..b8eb5a4aa1 100644 --- a/lisp/erc/erc-list.el +++ b/lisp/erc/erc-list.el @@ -119,24 +119,21 @@ (defvar erc-list-menu-mode-map (let ((map (make-keymap))) - (suppress-keymap map) + (set-keymap-parent map special-mode-map) (define-key map "k" 'erc-list-kill) (define-key map "j" 'erc-list-join) (define-key map "g" 'erc-list-revert) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) - (define-key map "q" 'quit-window) map) "Local keymap for `erc-list-mode' buffers.") -(defvar erc-list-menu-sort-button-map nil - "Local keymap for ERC list menu mode sorting buttons.") - -(unless erc-list-menu-sort-button-map +(defvar erc-list-menu-sort-button-map (let ((map (make-sparse-keymap))) (define-key map [header-line mouse-1] 'erc-list-menu-sort-by-column) (define-key map [follow-link] 'mouse-face) - (setq erc-list-menu-sort-button-map map))) + map) + "Local keymap for ERC list menu mode sorting buttons.") ;; Helper function that makes a buttonized column header. (defun erc-list-button (title column) @@ -146,7 +143,7 @@ 'mouse-face 'highlight 'keymap erc-list-menu-sort-button-map)) -(define-derived-mode erc-list-menu-mode nil "ERC-List" +(define-derived-mode erc-list-menu-mode special-mode "ERC-List" "Major mode for editing a list of irc channels." (setq header-line-format (concat diff --git a/lisp/erc/erc-track.el b/lisp/erc/erc-track.el index b15cdb023a..a89244f695 100644 --- a/lisp/erc/erc-track.el +++ b/lisp/erc/erc-track.el @@ -648,13 +648,12 @@ module, otherwise the keybindings will not do anything useful." (add-hook 'erc-send-completed-hook 'erc-user-is-active) (add-hook 'erc-server-001-functions 'erc-user-is-active)) (erc-track-add-to-mode-line erc-track-position-in-mode-line) - (setq erc-modified-channels-object (erc-modified-channels-object nil)) (erc-update-mode-line) (if (featurep 'xemacs) (defadvice switch-to-buffer (after erc-update (&rest args) activate) (erc-modified-channels-update)) (add-hook 'window-configuration-change-hook - 'erc-modified-channels-update)) + 'erc-window-configuration-change)) (add-hook 'erc-insert-post-hook 'erc-track-modified-channels) (add-hook 'erc-disconnected-hook 'erc-modified-channels-update)) ;; enable the tracking keybindings @@ -676,7 +675,7 @@ module, otherwise the keybindings will not do anything useful." (if (featurep 'xemacs) (ad-disable-advice 'switch-to-buffer 'after 'erc-update) (remove-hook 'window-configuration-change-hook - 'erc-modified-channels-update)) + 'erc-window-configuration-change)) (remove-hook 'erc-disconnected-hook 'erc-modified-channels-update) (remove-hook 'erc-insert-post-hook 'erc-track-modified-channels)) ;; disable the tracking keybindings @@ -731,6 +730,12 @@ only consider active buffers visible.") ;;; Tracking the channel modifications +(defun erc-window-configuration-change () + (unless (minibuffer-window-active-p (minibuffer-window)) + ;; delay this until command has finished to make sure window is + ;; actually visible before clearing activity + (add-hook 'post-command-hook 'erc-modified-channels-update))) + (defvar erc-modified-channels-update-inside nil "Variable to prevent running `erc-modified-channels-update' multiple times. Without it, you cannot debug `erc-modified-channels-display', @@ -758,8 +763,9 @@ ARGS are ignored." (erc-modified-channels-remove-buffer buffer)))) erc-modified-channels-alist) (when removed-channel - (erc-modified-channels-display) - (force-mode-line-update t))))) + (erc-modified-channels-display) + (force-mode-line-update t))) + (remove-hook 'post-command-hook 'erc-modified-channels-update))) (defvar erc-track-mouse-face (if (featurep 'xemacs) 'modeline-mousable diff --git a/lisp/faces.el b/lisp/faces.el index a9d26de604..2a0badab37 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -588,10 +588,14 @@ It must be one of the symbols `ultra-condensed', `extra-condensed', `:height' -VALUE must be either an integer specifying the height of the font to use -in 1/10 pt, a floating point number specifying the amount by which to -scale any underlying face, or a function, which is called with the old -height (from the underlying face), and should return the new height. +VALUE specifies the height of the font, in either absolute or relative +terms. An absolute height is an integer, and specifies font height in +units of 1/10 pt. A relative height is either a floating point number, +which specifies a scaling factor for the underlying face height; +or a function that takes a single argument (the underlying face height) +and returns the new height. Note that for the `default' face, +you can only specify an absolute height (since there is nothing +for it to be relative to). `:weight' diff --git a/lisp/files.el b/lisp/files.el index 7abf5361bb..8b42eaaddb 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -4855,22 +4855,35 @@ this happens by default." ;; Compute target name. (setq directory (directory-file-name (expand-file-name directory)) newname (directory-file-name (expand-file-name newname))) - (if (not (file-directory-p newname)) (make-directory newname parents)) + + (if (not (file-directory-p newname)) + ;; If NEWNAME is not an existing directory, create it; that + ;; is where we will copy the files of DIRECTORY. + (make-directory newname parents) + ;; If NEWNAME is an existing directory, we will copy into + ;; NEWNAME/[DIRECTORY-BASENAME]. + (setq newname (expand-file-name + (file-name-nondirectory + (directory-file-name directory)) + newname)) + (and (file-exists-p newname) + (not (file-directory-p newname)) + (error "Cannot overwrite non-directory %s with a directory" + newname)) + (make-directory newname t)) ;; Copy recursively. - (mapc - (lambda (file) - (let ((target (expand-file-name - (file-name-nondirectory file) newname)) - (attrs (file-attributes file))) - (cond ((file-directory-p file) - (copy-directory file target keep-time parents)) - ((stringp (car attrs)) ; Symbolic link - (make-symbolic-link (car attrs) target t)) - (t - (copy-file file target t keep-time))))) - ;; We do not want to copy "." and "..". - (directory-files directory 'full directory-files-no-dot-files-regexp)) + (dolist (file + ;; We do not want to copy "." and "..". + (directory-files directory 'full + directory-files-no-dot-files-regexp)) + (if (file-directory-p file) + (copy-directory file newname keep-time parents) + (let ((target (expand-file-name (file-name-nondirectory file) newname)) + (attrs (file-attributes file))) + (if (stringp (car attrs)) ; Symbolic link + (make-symbolic-link (car attrs) target t) + (copy-file file target t keep-time))))) ;; Set directory attributes. (set-file-modes newname (file-modes directory)) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index f9bcd902cd..8781ab3c0e 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,160 @@ +2011-02-10 Stefan Monnier <[email protected]> + + * message.el (message-bury): Don't pop up a new window when selected + window is dedicated. + +2011-02-10 Antoine Levitt <[email protected]> (tiny change) + + * gnus-sum.el (gnus-summary-save-parts): Use read-directory-name. + +2011-02-09 Lars Ingebrigtsen <[email protected]> + + * nntp.el (nntp-retrieve-group-data-early-disabled): Disable the async + code for now, since it doesn't work for all users. + +2011-02-09 Julien Danjou <[email protected]> + + * message.el (message-options): Make message-options really buffer + local. + +2011-02-08 Julien Danjou <[email protected]> + + * shr.el (shr-tag-body): Add support for text attribute in body + markups. + + * message.el (message-options): Make message-options a local variable. + +2011-02-07 Lars Ingebrigtsen <[email protected]> + + * nnimap.el (nnimap-update-info): Refactor slightly. + (nnimap-update-info): Tell Gnus whether there are any \Recent messages. + (nnimap-update-info): Clean up slightly. + (nnimap-quirk): Add quirk for Gmail IMAP which bugs out on NUL + characters. + (nnimap-process-quirk): Rename function to avoid collision. + (nnimap-update-info): Fix macrology bug-out. + (nnimap-update-info): Simplify split history test. + +2011-02-06 Lars Ingebrigtsen <[email protected]> + + * nntp.el (nntp-finish-retrieve-group-infos): Protect against the first + part not returning any data. + + * proto-stream.el (open-protocol-stream): Document the return value. + +2011-02-06 Julien Danjou <[email protected]> + + * message.el (message-setup-1): Handle message-generate-headers-first + set to t. + +2011-02-04 Lars Ingebrigtsen <[email protected]> + + * message.el (message-setup-1): Remove the read-only stuff, since it + doesn't work under XEmacs, for some reason. + + * gnus-sum.el (gnus-user-date): Rename back from + gnus-summary-user-date since user code refers to it. + + * shr.el (shr-render-td): Store the actual background colour used. + + * message.el (message-setup-1): Don't bind the constant + -forbidden-properties. + (message-setup-1): Revert previous change, since it needs to bind the + props to insert them. + (message-resend): Allow removing the read-only separator line. + +2011-02-03 Lars Ingebrigtsen <[email protected]> + + * nnimap.el (nnimap-request-accept-article): Give an error message if + the APPEND wasn't successful. + +2011-02-03 Adam Sjøgren <[email protected]> + + * gnus-start.el (gnus-get-unread-articles): Fix the call to methods + that have no groups. + +2011-02-03 Julien Danjou <[email protected]> + + * gnus-draft.el: Remove progn around gnus-draft-setup. + +2011-02-03 Lars Ingebrigtsen <[email protected]> + + * gnus-start.el (gnus-read-active-for-groups): This function is never + called with a nil `infos', so clean that up. + (gnus-get-unread-articles): Request active files from primary/secondary + methods that have no groups (yet). + +2011-02-03 Julien Danjou <[email protected]> + + * message.el (message-setup-1): Always generate References first. + (message-mail): Return the return value of message-setup, not always t. + (message-setup-1): Insert mail-header-separator with read-only and + intangible properties set. + + * gnus.el (gnus-summary-line-format): Add missing semi-colon for + user-date in docstring. + + * gnus-art.el (gnus-article-jump-to-part): Remove useless sit-for. + + * gnus.el (gnus-summary-line-format): Mention &user-date format in + docstring. + + * gnus.el (gnus-user-date-format-alist): Change default value. Use + defcustom, with type and group. Move from gnus-util.el. Rename to + gnus-summary-user-date-format-alist. + +2011-02-03 Glenn Morris <[email protected]> + + * nnimap.el (gnus-fetch-headers): Declare. + + * nnheader.el (gnus-range-add, gnus-remove-from-range): Autoload. + +2011-02-03 Lars Ingebrigtsen <[email protected]> + + * message.el (message-forward-make-body-digest-plain) + (message-followup, message-reply): Clean up things noted by Stefan. + + * gnus-art.el (gnus-article-setup-buffer): Stop the date timer if + gnus-article-update-date-headers is nil. + (gnus-article-date-headers): Rip out the old -treat-date-* stuff, since + it didn't really work with defcustom. + (article-update-date-lapsed): Make sure the window start doesn't move, + either. + +2011-02-01 Julien Danjou <[email protected]> + + * mm-uu.el (mm-uu-type-alist): Add support for git format-patch diff + format. + + * mm-decode.el (mm-inline-media-tests): Do not check for diff-mode it's + standard in Emacs nowadays. + +2011-02-01 Stefan Monnier <[email protected]> + + * message.el (message-expand-name): Don't trust the return value of + bbdb-complete-name. + (message-check-news-header-syntax): Remove unused var `start'. + (message-idna-to-ascii-rhs-1): Remove unused vars `rhs' and `address'. + (message-inhibit-body-encoding): Move to before first use. + (mail-abbrev-mode-regexp, Expires, User-Agent, Lines, Distribution) + (To, References, In-Reply-To, Newsgroups, Subject, Path, From) + (Organization, Message-ID, Date, mh-previous-window-config): + Defvar the vars using dynamic scoping. + +2011-02-01 Lars Ingebrigtsen <[email protected]> + + * shr.el (shr-render-td): Only do colours at the final rendering. + Should be slightly faster. + (shr-insert-table): Fix up TD background colours when doing the + vertical padding. + + * gnus-art.el (article-date-ut): Protect against articles with no Date + header. + (article-update-date-lapsed): Don't use current-column to find the + horizontal position. It's fragile in the presence of \003 characters. + + * gnus-start.el (gnus-read-active-file-1): Remove dead parameter infos. + 2011-01-31 Lars Ingebrigtsen <[email protected]> * gnus-art.el (article-transform-date): Rewrite to still work when @@ -80,8 +237,8 @@ 2011-01-28 Daiki Ueno <[email protected]> - * mml2015.el (mml2015-epg-sign, mml2015-epg-encrypt): Give - mml2015-signers higher precedence over mml2015-sign-with-sender. + * mml2015.el (mml2015-epg-sign, mml2015-epg-encrypt): + Give mml2015-signers higher precedence over mml2015-sign-with-sender. 2011-01-27 Lars Ingebrigtsen <[email protected]> diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index a76a71be64..54797b2a51 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -1014,24 +1014,7 @@ on parts -- for instance, adding Vcard info to a database." :group 'gnus-article-mime :type '(repeat (cons :format "%v" (string :tag "MIME type") function))) -(defcustom gnus-article-date-headers - (let ((types '(ut local english lapsed combined-lapsed - iso8601 original user-defined)) - default) - ;; Try to respect the legacy `gnus-treat-date-*' variables, if - ;; they're set. - (dolist (type types) - (let ((variable (intern (format "gnus-treat-date-%s" type)))) - (when (and (boundp variable) - (symbol-value variable)) - (push type default)))) - (when (and (or (not (boundp (intern "gnus-article-date-lapsed-new-header"))) - (not (symbol-value (intern "gnus-article-date-lapsed-new-header")))) - (memq 'lapsed default)) - (setq default (delq 'lapsed default))) - (or default - ;; If they weren't set, we default to `combined-lapsed'. - '(combined-lapsed))) +(defcustom gnus-article-date-headers '(combined-lapsed) "A list of Date header formats to display. Valid formats are `ut' (universal time), `local' (local time zone), `english' (readable English), `lapsed' (elapsed time), @@ -3443,7 +3426,8 @@ possible values." (delete-region (point-at-bol) (progn (gnus-article-forward-header) (point)))) - (article-transform-date date type bface eface)))))) + (when date + (article-transform-date date type bface eface))))))) (defun article-transform-date (date type bface eface) (dolist (this-type (cond @@ -3644,14 +3628,25 @@ function and want to see what the date was before converting." (set-buffer (window-buffer w)) (when (eq major-mode 'gnus-article-mode) (let ((old-line (count-lines (point-min) (point))) - (old-column (current-column))) + (old-column (- (point) (line-beginning-position))) + (window-start + (window-start (get-buffer-window (current-buffer))))) (goto-char (point-min)) (while (re-search-forward "^Date:" nil t) - (let ((type (get-text-property (match-beginning 0) 'gnus-date-type))) + (let ((type (get-text-property (match-beginning 0) + 'gnus-date-type))) (when (memq type '(lapsed combined-lapsed user-format)) + (unless (= window-start + (save-excursion + (forward-line 1) + (point))) + (setq window-start nil)) (save-excursion (article-date-ut type t (match-beginning 0))) - (forward-line 1)))) + (forward-line 1) + (when window-start + (set-window-start (get-buffer-window (current-buffer)) + (point)))))) (goto-char (point-min)) (when (> old-column 0) (setq old-line (1- old-line))) @@ -4504,9 +4499,13 @@ commands: (setq gnus-summary-buffer (gnus-summary-buffer-name gnus-newsgroup-name)) (gnus-summary-set-local-parameters gnus-newsgroup-name) - (when (and gnus-article-update-date-headers - (not article-lapsed-timer)) + (cond + ((and gnus-article-update-date-headers + (not article-lapsed-timer)) (gnus-start-date-timer gnus-article-update-date-headers)) + ((and (not gnus-article-update-date-headers) + article-lapsed-timer) + (gnus-stop-date-timer))) (current-buffer))))) ;; Set article window start at LINE, where LINE is the number of lines @@ -4875,8 +4874,6 @@ General format specifiers can also be used. See Info node (when (zerop parts) (error "No such part")) (pop-to-buffer gnus-article-buffer) - ;; FIXME: why is it necessary? - (sit-for 0) (or n (setq n (if (= parts 1) 1 @@ -7339,9 +7336,6 @@ as a symbol to FUN." (defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)") -;; FIXME: Maybe we should merge some of the functions that do quite similar -;; stuff? - (defun gnus-button-handle-describe-function (url) "Call `describe-function' when pushing the corresponding URL button." (describe-function diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index 78ef713c40..b613b6eaf3 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -244,55 +244,49 @@ Obeys the standard process/prefix convention." :version "23.1" ;; No Gnus :type 'hook) -;;; Utility functions -;;;!!!If this is byte-compiled, it fails miserably. -;;;!!!This is because `gnus-setup-message' uses uninterned symbols. -;;;!!!This has been fixed in recent versions of Emacs and XEmacs, -;;;!!!but for the time being, we'll just run this tiny function uncompiled. - -(progn - (defun gnus-draft-setup (narticle group &optional restore) - (let (ga) - (gnus-setup-message 'forward - (let ((article narticle)) - (message-mail) - (erase-buffer) - (if (not (gnus-request-restore-buffer article group)) - (error "Couldn't restore the article") - (when (and restore - (equal group "nndraft:queue")) - (mime-to-mml)) - ;; Insert the separator. - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (save-restriction - (narrow-to-region (point-min) (point)) - (setq ga - (message-fetch-field gnus-draft-meta-information-header))) - (insert mail-header-separator) - (forward-line 1) - (message-set-auto-save-file-name)))) - (gnus-backlog-remove-article group narticle) - (when (and ga - (ignore-errors (setq ga (car (read-from-string ga))))) - (setq gnus-newsgroup-name - (if (equal (car ga) "") nil (car ga))) - (gnus-configure-posting-styles) - (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) - (setq message-post-method - `(lambda (arg) - (gnus-post-method arg ,(car ga)))) - (unless (equal (cadr ga) "") - (dolist (article (cdr ga)) - (message-add-action - `(progn - (gnus-add-mark ,(car ga) 'replied ,article) - (gnus-request-set-mark ,(car ga) (list (list (list ,article) - 'add '(reply))))) - 'send)))) - (run-hooks 'gnus-draft-setup-hook)))) +(defun gnus-draft-setup (narticle group &optional restore) + (let (ga) + (gnus-setup-message 'forward + (let ((article narticle)) + (message-mail) + (let ((inhibit-read-only t)) + (erase-buffer)) + (if (not (gnus-request-restore-buffer article group)) + (error "Couldn't restore the article") + (when (and restore + (equal group "nndraft:queue")) + (mime-to-mml)) + ;; Insert the separator. + (goto-char (point-min)) + (search-forward "\n\n") + (forward-char -1) + (save-restriction + (narrow-to-region (point-min) (point)) + (setq ga + (message-fetch-field gnus-draft-meta-information-header))) + (insert mail-header-separator) + (forward-line 1) + (message-set-auto-save-file-name)))) + (gnus-backlog-remove-article group narticle) + (when (and ga + (ignore-errors (setq ga (car (read-from-string ga))))) + (setq gnus-newsgroup-name + (if (equal (car ga) "") nil (car ga))) + (gnus-configure-posting-styles) + (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga))) + (setq message-post-method + `(lambda (arg) + (gnus-post-method arg ,(car ga)))) + (unless (equal (cadr ga) "") + (dolist (article (cdr ga)) + (message-add-action + `(progn + (gnus-add-mark ,(car ga) 'replied ,article) + (gnus-request-set-mark ,(car ga) (list (list (list ,article) + 'add '(reply))))) + 'send)))) + (run-hooks 'gnus-draft-setup-hook))) (defun gnus-draft-article-sendable-p (article) "Say whether ARTICLE is sendable." diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 3879df3c4b..b8a6be8702 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -1700,9 +1700,20 @@ If SCAN, request a scan of that group as well." 'retrieve-group-data-early (car method))) (when (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan nil method)) + ;; Store the token we get back from -early so that we + ;; can pass it to -finish later. (setcar (nthcdr 3 elem) (gnus-retrieve-group-data-early method infos))))))) + ;; If we have primary/secondary select methods, but no groups from + ;; them, we still want to issue a retrieval request from them. + (dolist (method (cons gnus-select-method + gnus-secondary-select-methods)) + (when (and (not (assoc method type-cache)) + (gnus-check-backend-function 'request-list (car method))) + (with-current-buffer nntp-server-buffer + (gnus-read-active-file-1 method nil)))) + ;; Do the rest of the retrieval. (dolist (elem type-cache) (destructuring-bind (method method-type infos early-data) elem @@ -1741,15 +1752,16 @@ If SCAN, request a scan of that group as well." (defun gnus-read-active-for-groups (method infos early-data) (with-current-buffer nntp-server-buffer (cond + ;; Finish up getting the data from the methods that have -early + ;; methods. ((and (gnus-check-backend-function 'finish-retrieve-group-infos (car method)) - infos (or (not (gnus-agent-method-p method)) (gnus-online method))) (gnus-finish-retrieve-group-infos method infos early-data) (gnus-agent-save-active method)) - ((and (gnus-check-backend-function 'retrieve-groups (car method)) - infos) + ;; Most backends have -retrieve-groups. + ((gnus-check-backend-function 'retrieve-groups (car method)) (when (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan nil method)) (let (groups) @@ -1757,8 +1769,11 @@ If SCAN, request a scan of that group as well." (dolist (info infos (nreverse groups)) (push (gnus-group-real-name (gnus-info-group info)) groups)) method))) + ;; Virtually all backends have -request-list. ((gnus-check-backend-function 'request-list (car method)) - (gnus-read-active-file-1 method nil infos)) + (gnus-read-active-file-1 method nil)) + ;; Except nnvirtual and friends, where we request each group, one + ;; by one. (t (dolist (info infos) (gnus-activate-group (gnus-info-group info) nil nil method t)))))) @@ -1987,7 +2002,7 @@ If SCAN, request a scan of that group as well." (message "Quit reading the active file") nil)))))))) -(defun gnus-read-active-file-1 (method force &optional infos) +(defun gnus-read-active-file-1 (method force) (let (where mesg) (setq where (nth 1 method) mesg (format "Reading active file%s via %s..." diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 3b003b7462..8fac5021df 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -3852,6 +3852,56 @@ This function is intended to be used in ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024)))) (t (format "%dM" (/ c (* 1024.0 1024))))))) +(defcustom gnus-summary-user-date-format-alist + '(((gnus-seconds-today) . "Today, %H:%M") + ((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M") + (604800 . "%A %H:%M") ; That's one week + ((gnus-seconds-month) . "%A %d") + ((gnus-seconds-year) . "%B %d") + (t . "%b %d %Y")) ; This one is used when no other + ; does match + "Specifies date format depending on age of article. +This is an alist of items (AGE . FORMAT). AGE can be a number (of +seconds) or a Lisp expression evaluating to a number. When the age of +the article is less than this number, then use `format-time-string' +with the corresponding FORMAT for displaying the date of the article. +If AGE is not a number or a Lisp expression evaluating to a +non-number, then the corresponding FORMAT is used as a default value. + +Note that the list is processed from the beginning, so it should be +sorted by ascending AGE. Also note that items following the first +non-number AGE will be ignored. + +You can use the functions `gnus-seconds-today', `gnus-seconds-month' +and `gnus-seconds-year' in the AGE spec. They return the number of +seconds passed since the start of today, of this month, of this year, +respectively." + :version "24.1" + :group 'gnus-summary-format + :type '(alist :key-type sexp :value-type string)) +(make-obsolete-variable 'gnus-user-date-format-alist + 'gnus-summary-user-date-format-alist "24.1") + +(defun gnus-user-date (messy-date) + "Format the messy-date according to `gnus-summary-user-date-format-alist'. +Returns \" ? \" if there's bad input or if another error occurs. +Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." + (condition-case () + (let* ((messy-date (gnus-float-time (gnus-date-get-time messy-date))) + (now (gnus-float-time)) + ;;If we don't find something suitable we'll use this one + (my-format "%b %d '%y")) + (let* ((difference (- now messy-date)) + (templist gnus-summary-user-date-format-alist) + (top (eval (caar templist)))) + (while (if (numberp top) (< top difference) (not top)) + (progn + (setq templist (cdr templist)) + (setq top (eval (caar templist))))) + (if (stringp (cdr (car templist))) + (setq my-format (cdr (car templist))))) + (format-time-string (eval my-format) (seconds-to-time messy-date))) + (error " ? "))) (defun gnus-summary-set-local-parameters (group) "Go through the local params of GROUP and set all variable specs in that list." @@ -12037,9 +12087,9 @@ If REVERSE, save parts that do not match TYPE." gnus-summary-save-parts-default-mime) 'gnus-summary-save-parts-type-history) (setq gnus-summary-save-parts-last-directory - (read-file-name "Save to directory: " - gnus-summary-save-parts-last-directory - nil t)) + (read-directory-name "Save to directory: " + gnus-summary-save-parts-last-directory + nil t)) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index d298c71544..67c49096b9 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -477,51 +477,6 @@ Cache the result as a text property stored in DATE." (put-text-property 0 1 'gnus-time time d) time))))) -(defvar gnus-user-date-format-alist - '(((gnus-seconds-today) . "%k:%M") - (604800 . "%a %k:%M") ;;that's one week - ((gnus-seconds-month) . "%a %d") - ((gnus-seconds-year) . "%b %d") - (t . "%b %d '%y")) ;;this one is used when no - ;;other does match - "Specifies date format depending on age of article. -This is an alist of items (AGE . FORMAT). AGE can be a number (of -seconds) or a Lisp expression evaluating to a number. When the age of -the article is less than this number, then use `format-time-string' -with the corresponding FORMAT for displaying the date of the article. -If AGE is not a number or a Lisp expression evaluating to a -non-number, then the corresponding FORMAT is used as a default value. - -Note that the list is processed from the beginning, so it should be -sorted by ascending AGE. Also note that items following the first -non-number AGE will be ignored. - -You can use the functions `gnus-seconds-today', `gnus-seconds-month' -and `gnus-seconds-year' in the AGE spec. They return the number of -seconds passed since the start of today, of this month, of this year, -respectively.") - -(defun gnus-user-date (messy-date) - "Format the messy-date according to gnus-user-date-format-alist. -Returns \" ? \" if there's bad input or if another error occurs. -Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"." - (condition-case () - (let* ((messy-date (gnus-float-time (gnus-date-get-time messy-date))) - (now (gnus-float-time)) - ;;If we don't find something suitable we'll use this one - (my-format "%b %d '%y")) - (let* ((difference (- now messy-date)) - (templist gnus-user-date-format-alist) - (top (eval (caar templist)))) - (while (if (numberp top) (< top difference) (not top)) - (progn - (setq templist (cdr templist)) - (setq top (eval (caar templist))))) - (if (stringp (cdr (car templist))) - (setq my-format (cdr (car templist))))) - (format-time-string (eval my-format) (seconds-to-time messy-date))) - (error " ? "))) - (defun gnus-dd-mmm (messy-date) "Return a string like DD-MMM from a big messy string." (condition-case () diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 47b772b78d..4cbdee53ab 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -2908,50 +2908,62 @@ gnus-registry.el will populate this if it's loaded.") It works along the same lines as a normal formatting string, with some simple extensions. -%N Article number, left padded with spaces (string) -%S Subject (string) -%s Subject if it is at the root of a thread, and \"\" otherwise (string) -%n Name of the poster (string) -%a Extracted name of the poster (string) -%A Extracted address of the poster (string) -%F Contents of the From: header (string) -%f Contents of the From: or To: headers (string) -%x Contents of the Xref: header (string) -%D Date of the article (string) -%d Date of the article (string) in DD-MMM format -%o Date of the article (string) in YYYYMMDD`T'HHMMSS format -%M Message-id of the article (string) -%r References of the article (string) -%c Number of characters in the article (integer) -%k Pretty-printed version of the above (string) - For example, \"1.2k\" or \"0.4M\". -%L Number of lines in the article (integer) -%I Indentation based on thread level (a string of spaces) -%B A complex trn-style thread tree (string) - The variables `gnus-sum-thread-*' can be used for customization. -%T A string with two possible values: 80 spaces if the article - is on thread level two or larger and 0 spaces on level one -%R \"A\" if this article has been replied to, \" \" otherwise (character) -%U Status of this article (character, \"R\", \"K\", \"-\" or \" \") -%[ Opening bracket (character, \"[\" or \"<\") -%] Closing bracket (character, \"]\" or \">\") -%> Spaces of length thread-level (string) -%< Spaces of length (- 20 thread-level) (string) -%i Article score (number) -%z Article zcore (character) -%t Number of articles under the current thread (number). -%e Whether the thread is empty or not (character). -%V Total thread score (number). -%P The line number (number). -%O Download mark (character). -%* If present, indicates desired cursor position - (instead of after first colon). -%u User defined specifier. The next character in the format string should - be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed the - current header as argument. The function should return a string, which - will be inserted into the summary just like information from any other - summary specifier. +%N Article number, left padded with spaces (string) +%S Subject (string) +%s Subject if it is at the root of a thread, and \"\" + otherwise (string) +%n Name of the poster (string) +%a Extracted name of the poster (string) +%A Extracted address of the poster (string) +%F Contents of the From: header (string) +%f Contents of the From: or To: headers (string) +%x Contents of the Xref: header (string) +%D Date of the article (string) +%d Date of the article (string) in DD-MMM format +%o Date of the article (string) in YYYYMMDD`T'HHMMSS + format +%M Message-id of the article (string) +%r References of the article (string) +%c Number of characters in the article (integer) +%k Pretty-printed version of the above (string) + For example, \"1.2k\" or \"0.4M\". +%L Number of lines in the article (integer) +%I Indentation based on thread level (a string of + spaces) +%B A complex trn-style thread tree (string) + The variables `gnus-sum-thread-*' can be used for + customization. +%T A string with two possible values: 80 spaces if the + article is on thread level two or larger and 0 spaces + on level one +%R \"A\" if this article has been replied to, \" \" + otherwise (character) +%U Status of this article (character, \"R\", \"K\", + \"-\" or \" \") +%[ Opening bracket (character, \"[\" or \"<\") +%] Closing bracket (character, \"]\" or \">\") +%> Spaces of length thread-level (string) +%< Spaces of length (- 20 thread-level) (string) +%i Article score (number) +%z Article zcore (character) +%t Number of articles under the current thread (number). +%e Whether the thread is empty or not (character). +%V Total thread score (number). +%P The line number (number). +%O Download mark (character). +%* If present, indicates desired cursor position + (instead of after first colon). +%u User defined specifier. The next character in the + format string should be a letter. Gnus will call the + function gnus-user-format-function-X, where X is the + letter following %u. The function will be passed the + current header as argument. The function should + return a string, which will be inserted into the + summary just like information from any other summary + specifier. +&user-date; Age sensitive date format. Various date format is + defined in `gnus-summary-user-date-format-alist'. + The %U (status), %R (replied) and %z (zcore) specs have to be handled with care. For reasons of efficiency, Gnus will compute what column diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index e7783ba013..42b6195098 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -129,6 +129,17 @@ :group 'message-buffers :type '(choice function (const nil))) +(defcustom message-cite-style nil + "The overall style to be used when yanking cited text. +Values are either `traditional' (cited text first), +`top-post' (cited text at the bottom), or nil (don't override the +individual message variables)." + :version "24.1" + :group 'message-various + :type '(choice (const :tag "None" :value nil) + (const :tag "Traditional" :value traditional) + (const :tag "Top-post" :value top-post))) + (defcustom message-fcc-handler-function 'message-output "*A function called to save outgoing articles. This function will be called with the name of the file to store the @@ -869,11 +880,7 @@ variable isn't used." ;; create a dependence to `gnus.el'. :type 'sexp) -;; FIXME: This should be a temporary workaround until someone implements a -;; proper solution. If a crash happens while replying, the auto-save file -;; will *not* have a `References:' header if `message-generate-headers-first' -;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138 -(defcustom message-generate-headers-first '(references) +(defcustom message-generate-headers-first nil "Which headers should be generated before starting to compose a message. If t, generate all required headers. This can also be a list of headers to generate. The variables `message-required-news-headers' and @@ -885,7 +892,6 @@ will not have a visible effect for those headers." :group 'message-headers :link '(custom-manual "(message)Message Headers") :type '(choice (const :tag "None" nil) - (const :tag "References" '(references)) (const :tag "All" t) (repeat (sexp :tag "Header")))) @@ -1808,6 +1814,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (defvar message-options nil "Some saved answers when sending message.") +(make-variable-buffer-local 'message-options) (defvar message-send-mail-real-function nil "Internal send mail function.") @@ -2769,7 +2776,7 @@ message composition doesn't break too bad." :link '(custom-manual "(message)Various Message Variables") :type 'boolean) -(defconst message-forbidden-properties +(defvar message-forbidden-properties ;; No reason this should be clutter up customize. We make it a ;; property list (rather than a list of property symbols), to be ;; directly useful for `remove-text-properties'. @@ -4004,11 +4011,11 @@ Instead, just auto-save the buffer and then bury it." (defun message-bury (buffer) "Bury this mail BUFFER." - (let ((newbuf (other-buffer buffer))) - (bury-buffer buffer) - (if message-return-action - (apply (car message-return-action) (cdr message-return-action)) - (switch-to-buffer newbuf)))) + (if message-return-action + (progn + (bury-buffer buffer) + (apply (car message-return-action) (cdr message-return-action))) + (with-current-buffer buffer (bury-buffer)))) (defun message-send (&optional arg) "Send the message in the current buffer. @@ -4345,7 +4352,7 @@ This function could be useful in `message-setup-hook'." (tembuf (message-generate-new-buffer-clone-locals " message temp")) (curbuf (current-buffer)) (id (message-make-message-id)) (n 1) - plist total header required-mail-headers) + plist total header) (while (not (eobp)) (if (< (point-max) (+ p message-send-mail-partially-limit)) (goto-char (point-max)) @@ -4677,6 +4684,8 @@ to find out how to use this." ;; should never happen (t (error "qmail-inject reported unknown failure")))) +(defvar mh-previous-window-config) + (defun message-send-mail-with-mh () "Send the prepared message buffer with mh." (let ((mh-previous-window-config nil) @@ -4897,8 +4906,7 @@ Otherwise, generate and save a value for `canlock-password' first." t)) ;; Check long header lines. (message-check 'long-header-lines - (let ((start (point)) - (header nil) + (let ((header nil) (length 0) found) (while (and (not found) @@ -4907,7 +4915,6 @@ Otherwise, generate and save a value for `canlock-password' first." (setq found t length (- (point) (match-beginning 0))) (setq header (match-string-no-properties 1))) - (setq start (match-beginning 0)) (forward-line 1)) (if found (y-or-n-p (format "Your %s header is too long (%d). Really post? " @@ -5750,7 +5757,7 @@ subscribed address (and not the additional To and Cc header contents)." (defun message-idna-to-ascii-rhs-1 (header) "Interactively potentially IDNA encode domain names in HEADER." (let ((field (message-fetch-field header)) - rhs ace address) + ace) (when field (dolist (rhs (mm-delete-duplicates @@ -5799,6 +5806,21 @@ See `message-idna-encode'." (message-idna-to-ascii-rhs-1 "Mail-Followup-To") (message-idna-to-ascii-rhs-1 "Cc"))))) +(defvar Date) +(defvar Message-ID) +(defvar Organization) +(defvar From) +(defvar Path) +(defvar Subject) +(defvar Newsgroups) +(defvar In-Reply-To) +(defvar References) +(defvar To) +(defvar Distribution) +(defvar Lines) +(defvar User-Agent) +(defvar Expires) + (defun message-generate-headers (headers) "Prepare article HEADERS. Headers already prepared in the buffer are not modified." @@ -6390,30 +6412,35 @@ are not included." (funcall message-default-headers) message-default-headers)) (or (bolp) (insert ?\n))) - (insert mail-header-separator "\n") + (insert (concat mail-header-separator "\n")) (forward-line -1) - (when (message-news-p) - (when message-default-news-headers - (insert message-default-news-headers) - (or (bolp) (insert ?\n))) - (when message-generate-headers-first + ;; If a crash happens while replying, the auto-save file would *not* have a + ;; `References:' header if `message-generate-headers-first' was nil. + ;; Therefore, always generate it first. + (let ((message-generate-headers-first + (if (eq message-generate-headers-first t) + t + (append message-generate-headers-first '(References))))) + (when (message-news-p) + (when message-default-news-headers + (insert message-default-news-headers) + (or (bolp) (insert ?\n))) (message-generate-headers (message-headers-to-generate - (append message-required-news-headers - message-required-headers) - message-generate-headers-first - '(Lines Subject))))) - (when (message-mail-p) - (when message-default-mail-headers - (insert message-default-mail-headers) - (or (bolp) (insert ?\n))) - (when message-generate-headers-first + (append message-required-news-headers + message-required-headers) + message-generate-headers-first + '(Lines Subject)))) + (when (message-mail-p) + (when message-default-mail-headers + (insert message-default-mail-headers) + (or (bolp) (insert ?\n))) (message-generate-headers (message-headers-to-generate - (append message-required-mail-headers - message-required-headers) - message-generate-headers-first - '(Lines Subject))))) + (append message-required-mail-headers + message-required-headers) + message-generate-headers-first + '(Lines Subject))))) (run-hooks 'message-signature-setup-hook) (message-insert-signature) (save-restriction @@ -6525,9 +6552,7 @@ is a function used to switch to and display the mail buffer." (dolist (h other-headers other-headers) (if (stringp (car h)) (setcar h (intern (capitalize (car h))))))) yank-action send-actions continue switch-function - return-action) - ;; FIXME: Should return nil if failure. - t)) + return-action))) ;;;###autoload (defun message-news (&optional newsgroups subject) @@ -6759,7 +6784,7 @@ Useful functions to put in this list include: (interactive) (require 'gnus-sum) ; for gnus-list-identifiers (let ((cur (current-buffer)) - from subject date reply-to to cc + from subject date references message-id follow-to (inhibit-point-motion-hooks t) (message-this-is-mail t) @@ -7280,11 +7305,9 @@ Optional DIGEST will use digest to forward." (defun message-forward-make-body-digest-plain (forward-buffer) (insert "\n-------------------- Start of forwarded message --------------------\n") - (let ((b (point)) e) - (mml-insert-buffer forward-buffer) - (setq e (point)) - (insert - "\n-------------------- End of forwarded message --------------------\n"))) + (mml-insert-buffer forward-buffer) + (insert + "\n-------------------- End of forwarded message --------------------\n")) (defun message-forward-make-body-digest-mime (forward-buffer) (insert "\n<#multipart type=digest>\n") @@ -7404,6 +7427,8 @@ is for the internal use." (setq rmail-insert-mime-forwarded-message-function 'message-forward-rmail-make-body)) +(defvar message-inhibit-body-encoding nil) + ;;;###autoload (defun message-resend (address) "Resend the current article to ADDRESS." @@ -7416,7 +7441,8 @@ is for the internal use." ;; We first set up a normal mail buffer. (unless (message-mail-user-agent) (set-buffer (get-buffer-create " *message resend*")) - (erase-buffer)) + (let ((inhibit-read-only t)) + (erase-buffer))) (let ((message-this-is-mail t) message-generate-hashcash message-setup-hook) @@ -7433,7 +7459,8 @@ is for the internal use." (insert "Resent-")) (widen) (forward-line) - (delete-region (point) (point-max)) + (let ((inhibit-read-only t)) + (delete-region (point) (point-max))) (setq beg (point)) ;; Insert the message to be resent. (insert-buffer-substring cur) @@ -7790,6 +7817,8 @@ those headers." (lookup-key global-map "\t") 'indent-relative))))) +(defvar mail-abbrev-mode-regexp) + (defun message-completion-function () (let ((alist message-completion-alist)) (while (and alist @@ -7867,7 +7896,12 @@ those headers." (eudc-expand-inline)) ((and (memq 'bbdb message-expand-name-databases) (fboundp 'bbdb-complete-name)) - (bbdb-complete-name)) + (let ((starttick (buffer-modified-tick))) + (or (bbdb-complete-name) + ;; Apparently, bbdb-complete-name can return nil even when + ;; completion took place. So let's double check the buffer was + ;; not modified. + (/= starttick (buffer-modified-tick))))) (t (expand-abbrev)))) @@ -7928,8 +7962,6 @@ regexp VARSTR." ;;; MIME functions ;;; -(defvar message-inhibit-body-encoding nil) - (defun message-encode-message-body () (unless message-inhibit-body-encoding (let ((mail-parse-charset (or mail-parse-charset diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index d7bc882a84..3909e12186 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -223,17 +223,9 @@ before the external MIME handler is invoked." ("text/plain" mm-inline-text identity) ("text/enriched" mm-inline-text identity) ("text/richtext" mm-inline-text identity) - ("text/x-patch" mm-display-patch-inline - (lambda (handle) - ;; If the diff-mode.el package is installed, the function is - ;; autoloaded. Checking (locate-library "diff-mode") would be trying - ;; to cater to broken installations. OTOH checking the function - ;; makes it possible to install another package which provides an - ;; alternative implementation of diff-mode. --Stef - (fboundp 'diff-mode))) + ("text/x-patch" mm-display-patch-inline identity) ;; In case mime.types uses x-diff (as does Debian's mime-support-3.40). - ("text/x-diff" mm-display-patch-inline - (lambda (handle) (fboundp 'diff-mode))) + ("text/x-diff" mm-display-patch-inline identity) ("application/emacs-lisp" mm-display-elisp-inline identity) ("application/x-emacs-lisp" mm-display-elisp-inline identity) ("application/x-shellscript" mm-display-shell-script-inline identity) diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 7f96f449da..14b4419830 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -158,6 +158,12 @@ This can be either \"inline\" or \"attachment\".") mm-uu-diff-extract nil mm-uu-diff-test) + (git-format-patch + "^diff --git " + "^-- " + mm-uu-diff-extract + nil + mm-uu-diff-test) (message-marks ;; Text enclosed with tags similar to `message-mark-insert-begin' and ;; `message-mark-insert-end'. Don't use those variables to avoid diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 20cdeb557d..ae5893ae42 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -43,6 +43,8 @@ (require 'mail-utils) (require 'mm-util) (require 'gnus-util) +(autoload 'gnus-range-add "gnus-range") +(autoload 'gnus-remove-from-range "gnus-range") ;; FIXME none of these are used explicitly in this file. (autoload 'gnus-sorted-intersection "gnus-range") (autoload 'gnus-intersection "gnus-range") diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 005f60b5c7..a6fe6b1489 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -969,30 +969,59 @@ textual parts.") (nnimap-add-cr) (setq message (buffer-substring-no-properties (point-min) (point-max))) (with-current-buffer (nnimap-buffer) - ;; If we have this group open read-only, then unselect it - ;; before appending to it. - (when (equal (nnimap-examined nnimap-object) group) - (nnimap-unselect-group)) - (erase-buffer) - (setq sequence (nnimap-send-command - "APPEND %S {%d}" (utf7-encode group t) - (length message))) - (unless nnimap-streaming - (nnimap-wait-for-connection "^[+]")) - (process-send-string (get-buffer-process (current-buffer)) message) - (process-send-string (get-buffer-process (current-buffer)) - (if (nnimap-newlinep nnimap-object) - "\n" - "\r\n")) - (let ((result (nnimap-get-response sequence))) - (if (not (car result)) - (progn - (nnheader-message 7 "%s" (nnheader-get-report-string 'nnimap)) - nil) - (cons group - (or (nnimap-find-uid-response "APPENDUID" (car result)) - (nnimap-find-article-by-message-id - group message-id))))))))) + (when (setq message (nnimap-process-quirk "OK Gimap " 'append message)) + ;; If we have this group open read-only, then unselect it + ;; before appending to it. + (when (equal (nnimap-examined nnimap-object) group) + (nnimap-unselect-group)) + (erase-buffer) + (setq sequence (nnimap-send-command + "APPEND %S {%d}" (utf7-encode group t) + (length message))) + (unless nnimap-streaming + (nnimap-wait-for-connection "^[+]")) + (process-send-string (get-buffer-process (current-buffer)) message) + (process-send-string (get-buffer-process (current-buffer)) + (if (nnimap-newlinep nnimap-object) + "\n" + "\r\n")) + (let ((result (nnimap-get-response sequence))) + (if (not (nnimap-ok-p result)) + (progn + (nnheader-report 'nnimap "%s" result) + nil) + (cons group + (or (nnimap-find-uid-response "APPENDUID" (car result)) + (nnimap-find-article-by-message-id + group message-id)))))))))) + +(defun nnimap-process-quirk (greeting-match type data) + (when (and (nnimap-greeting nnimap-object) + (string-match "OK Gimap " (nnimap-greeting nnimap-object)) + (eq type 'append) + (string-match "\000" data)) + (let ((choice (gnus-multiple-choice + "Message contains NUL characters. Delete, continue, abort? " + '((?d "Delete NUL characters") + (?c "Try to APPEND the message as is") + (?a "Abort"))))) + (cond + ((eq choice ?a) + (nnheader-report 'nnimap "Aborted APPEND due to NUL characters")) + ((eq choice ?c) + data) + (t + (with-temp-buffer + (insert data) + (goto-char (point-min)) + (while (search-forward "\000" nil t) + (replace-match "" t t)) + (buffer-string))))))) + +(defun nnimap-ok-p (value) + (and (consp value) + (consp (car value)) + (equal (caar value) "OK"))) (defun nnimap-find-uid-response (name list) (let ((result (car (last (nnimap-find-response-element name list))))) @@ -1244,10 +1273,9 @@ textual parts.") (t ;; No articles and no uidnext. nil))) - (gnus-set-active - group - (cons (car active) - (or high (1- uidnext))))) + (gnus-set-active group + (cons (car active) + (or high (1- uidnext))))) ;; See whether this is a read-only group. (unless (eq permanent-flags 'not-scanned) (gnus-group-set-parameter @@ -1311,6 +1339,14 @@ textual parts.") (when new-marks (push (cons (car type) new-marks) marks))))) (gnus-info-set-marks info marks t)))) + ;; Tell Gnus whether there are any \Recent messages in any of + ;; the groups. + (let ((recent (cdr (assoc '%Recent flags)))) + (when (and active + recent + (> (car (last recent)) (cdr active))) + (push (list (cons (gnus-group-real-name group) 0)) + nnmail-split-history))) ;; Note the active level for the next run-through. (gnus-group-set-parameter info 'active (gnus-active group)) (gnus-group-set-parameter info 'uidvalidity uidvalidity) @@ -1473,6 +1509,9 @@ textual parts.") (setq nnimap-status-string "Read-only server") nil) +(declare-function gnus-fetch-headers "gnus-sum" + (articles &optional limit force-new dependencies)) + (deffoo nnimap-request-thread (header) (let* ((id (mail-header-id header)) (refs (split-string diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index cae0150dd1..eb2dd00463 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -774,14 +774,15 @@ command whose response triggered the error." (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max)) 'headers))))) -(deffoo nntp-retrieve-group-data-early (server infos) +(deffoo nntp-retrieve-group-data-early-disabled (server infos) "Retrieve group info on INFOS." (nntp-with-open-group nil server (when (nntp-find-connection-buffer nntp-server-buffer) ;; The first time this is run, this variable is `try'. So we ;; try. (when (eq nntp-server-list-active-group 'try) - (nntp-try-list-active (gnus-group-real-name (gnus-info-group (car infos))))) + (nntp-try-list-active + (gnus-group-real-name (gnus-info-group (car infos))))) (with-current-buffer (nntp-find-connection-buffer nntp-server-buffer) (erase-buffer) (let ((nntp-inhibit-erase t) @@ -792,7 +793,7 @@ command whose response triggered the error." nil command (gnus-group-real-name (gnus-info-group info))))) (length infos))))) -(deffoo nntp-finish-retrieve-group-infos (server infos count) +(deffoo nntp-finish-retrieve-group-infos-disabled (server infos count) (nntp-with-open-group nil server (let ((buf (nntp-find-connection-buffer nntp-server-buffer)) (method (gnus-find-method-for-group @@ -800,7 +801,8 @@ command whose response triggered the error." (car infos))) (received 0) (last-point 1)) - (when buf + (when (and buf + count) (with-current-buffer buf (while (and (gnus-buffer-live-p buf) (progn diff --git a/lisp/gnus/proto-stream.el b/lisp/gnus/proto-stream.el index 9117ac9f4e..fdf2abfea0 100644 --- a/lisp/gnus/proto-stream.el +++ b/lisp/gnus/proto-stream.el @@ -94,7 +94,15 @@ query server for capabilities. For instance, for IMAP this is :starttls-function -- a function that takes one parameter, which is the response to the capaibility command. It should return nil if it turns out that the server doesn't support STARTTLS, or the -command to switch on STARTTLS otherwise." +command to switch on STARTTLS otherwise. + +The return value from this function is a four-element list, where +the first element is the stream (if connection was successful); +the second element is the \"greeting\", i. e., the string the +server sent over on initial contact; the third element is the +capability string; and the fourth element is either `network' or +`tls', depending on whether the connection ended up being +encrypted or not." (let ((type (or (cadr (memq :type parameters)) 'network))) (cond ((eq type 'starttls) diff --git a/lisp/gnus/shr.el b/lisp/gnus/shr.el index f3c75ccd6a..bb9695ebb7 100644 --- a/lisp/gnus/shr.el +++ b/lisp/gnus/shr.el @@ -601,7 +601,8 @@ ones, in case fg and bg are nil." (when fg (shr-put-color start end :foreground (cadr new-colors))) (when bg - (shr-put-color start end :background (car new-colors))))))) + (shr-put-color start end :background (car new-colors)))) + new-colors))) ;; Put a color in the region, but avoid putting colors on on blank ;; text at the start of the line, and the newline at the end, to avoid @@ -695,7 +696,8 @@ ones, in case fg and bg are nil." (defun shr-tag-body (cont) (let* ((start (point)) - (fgcolor (cdr (assq :fgcolor cont))) + (fgcolor (cdr (or (assq :fgcolor cont) + (assq :text cont)))) (bgcolor (cdr (assq :bgcolor cont))) (shr-stylesheet (list (cons 'color fgcolor) (cons 'background-color bgcolor)))) @@ -1055,8 +1057,11 @@ ones, in case fg and bg are nil." ;; possibly. (dotimes (i (- height (length lines))) (end-of-line) - (insert (make-string (string-width (car lines)) ? ) - shr-table-vertical-line) + (let ((start (point))) + (insert (make-string (string-width (car lines)) ? ) + shr-table-vertical-line) + (when (nth 4 column) + (shr-put-color start (1- (point)) :background (nth 4 column)))) (forward-line 1))))) (shr-insert-table-ruler widths))) @@ -1123,7 +1128,7 @@ ones, in case fg and bg are nil." (fgcolor (cdr (assq :fgcolor cont))) (style (cdr (assq :style cont))) (shr-stylesheet shr-stylesheet) - overlays) + overlays actual-colors) (when style (setq style (and (string-match "color" style) (shr-parse-style style)))) @@ -1173,17 +1178,19 @@ ones, in case fg and bg are nil." (end-of-line) (when (> (- width (current-column)) 0) (insert (make-string (- width (current-column)) ? ))) - (forward-line 1)))) - (when style - (shr-colorize-region - (point-min) (point-max) - (cdr (assq 'color shr-stylesheet)) - (cdr (assq 'background-color shr-stylesheet)))) + (forward-line 1))) + (when style + (setq actual-colors + (shr-colorize-region + (point-min) (point-max) + (cdr (assq 'color shr-stylesheet)) + (cdr (assq 'background-color shr-stylesheet)))))) (if fill (list max (count-lines (point-min) (point-max)) (split-string (buffer-string) "\n") - (shr-collect-overlays)) + (shr-collect-overlays) + (car actual-colors)) (list max (shr-natural-width))))))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 826145d7af..724b018667 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -33,18 +33,19 @@ (require 'view) (eval-when-compile (require 'easymenu)) -(defvar help-mode-map (make-sparse-keymap) +(defvar help-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map button-buffer-map) + + (define-key map [mouse-2] 'help-follow-mouse) + (define-key map "\C-c\C-b" 'help-go-back) + (define-key map "\C-c\C-f" 'help-go-forward) + (define-key map "\C-c\C-c" 'help-follow-symbol) + ;; Documentation only, since we use minor-mode-overriding-map-alist. + (define-key map "\r" 'help-follow) + map) "Keymap for help mode.") -(set-keymap-parent help-mode-map button-buffer-map) - -(define-key help-mode-map [mouse-2] 'help-follow-mouse) -(define-key help-mode-map "\C-c\C-b" 'help-go-back) -(define-key help-mode-map "\C-c\C-f" 'help-go-forward) -(define-key help-mode-map "\C-c\C-c" 'help-follow-symbol) -;; Documentation only, since we use minor-mode-overriding-map-alist. -(define-key help-mode-map "\r" 'help-follow) - (easy-menu-define help-mode-menu help-mode-map "Menu for Help Mode." '("Help-Mode" diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el index d2c45e1132..a0b5844582 100644 --- a/lisp/hi-lock.el +++ b/lisp/hi-lock.el @@ -87,8 +87,7 @@ ;;; Code: -(eval-and-compile - (require 'font-lock)) +(require 'font-lock) (defgroup hi-lock nil "Interactively add and remove font-lock patterns for highlighting text." @@ -239,45 +238,47 @@ a library is being loaded.") (make-variable-buffer-local 'hi-lock-file-patterns) (put 'hi-lock-file-patterns 'permanent-local t) -(defvar hi-lock-menu (make-sparse-keymap "Hi Lock") +(defvar hi-lock-menu + (let ((map (make-sparse-keymap "Hi Lock"))) + (define-key-after map [highlight-regexp] + '(menu-item "Highlight Regexp..." highlight-regexp + :help "Highlight text matching PATTERN (a regexp).")) + + (define-key-after map [highlight-phrase] + '(menu-item "Highlight Phrase..." highlight-phrase + :help "Highlight text matching PATTERN (a regexp processed to match phrases).")) + + (define-key-after map [highlight-lines-matching-regexp] + '(menu-item "Highlight Lines..." highlight-lines-matching-regexp + :help "Highlight lines containing match of PATTERN (a regexp).")) + + (define-key-after map [unhighlight-regexp] + '(menu-item "Remove Highlighting..." unhighlight-regexp + :help "Remove previously entered highlighting pattern." + :enable hi-lock-interactive-patterns)) + + (define-key-after map [hi-lock-write-interactive-patterns] + '(menu-item "Patterns to Buffer" hi-lock-write-interactive-patterns + :help "Insert interactively added REGEXPs into buffer at point." + :enable hi-lock-interactive-patterns)) + + (define-key-after map [hi-lock-find-patterns] + '(menu-item "Patterns from Buffer" hi-lock-find-patterns + :help "Use patterns (if any) near top of buffer.")) + map) "Menu for hi-lock mode.") -(define-key-after hi-lock-menu [highlight-regexp] - '(menu-item "Highlight Regexp..." highlight-regexp - :help "Highlight text matching PATTERN (a regexp).")) - -(define-key-after hi-lock-menu [highlight-phrase] - '(menu-item "Highlight Phrase..." highlight-phrase - :help "Highlight text matching PATTERN (a regexp processed to match phrases).")) - -(define-key-after hi-lock-menu [highlight-lines-matching-regexp] - '(menu-item "Highlight Lines..." highlight-lines-matching-regexp - :help "Highlight lines containing match of PATTERN (a regexp).")) - -(define-key-after hi-lock-menu [unhighlight-regexp] - '(menu-item "Remove Highlighting..." unhighlight-regexp - :help "Remove previously entered highlighting pattern." - :enable hi-lock-interactive-patterns)) - -(define-key-after hi-lock-menu [hi-lock-write-interactive-patterns] - '(menu-item "Patterns to Buffer" hi-lock-write-interactive-patterns - :help "Insert interactively added REGEXPs into buffer at point." - :enable hi-lock-interactive-patterns)) - -(define-key-after hi-lock-menu [hi-lock-find-patterns] - '(menu-item "Patterns from Buffer" hi-lock-find-patterns - :help "Use patterns (if any) near top of buffer.")) - -(defvar hi-lock-map (make-sparse-keymap "Hi Lock") +(defvar hi-lock-map + (let ((map (make-sparse-keymap "Hi Lock"))) + (define-key map "\C-xwi" 'hi-lock-find-patterns) + (define-key map "\C-xwl" 'highlight-lines-matching-regexp) + (define-key map "\C-xwp" 'highlight-phrase) + (define-key map "\C-xwh" 'highlight-regexp) + (define-key map "\C-xwr" 'unhighlight-regexp) + (define-key map "\C-xwb" 'hi-lock-write-interactive-patterns) + map) "Key map for hi-lock.") -(define-key hi-lock-map "\C-xwi" 'hi-lock-find-patterns) -(define-key hi-lock-map "\C-xwl" 'highlight-lines-matching-regexp) -(define-key hi-lock-map "\C-xwp" 'highlight-phrase) -(define-key hi-lock-map "\C-xwh" 'highlight-regexp) -(define-key hi-lock-map "\C-xwr" 'unhighlight-regexp) -(define-key hi-lock-map "\C-xwb" 'hi-lock-write-interactive-patterns) - ;; Visible Functions ;;;###autoload diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index 55375f1e06..c77a479c0b 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -771,7 +771,8 @@ The value from `ibuffer-saved-filter-groups' is used." (defun ibuffer-filter-disable () "Disable all filters currently in effect in this buffer." (interactive) - (setq ibuffer-filtering-qualifiers nil) + (setq ibuffer-filtering-qualifiers nil + ibuffer-filter-groups nil) (let ((buf (ibuffer-current-buffer))) (ibuffer-update nil t) (when buf diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 3e5b301cbf..f7ac24fa2e 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -384,14 +384,66 @@ directory, like `default-directory'." (regexp :tag "To"))) :group 'ibuffer) +(defvar ibuffer-mode-groups-popup + (let ((groups-map (make-sparse-keymap "Filter Groups"))) + ;; Filter groups + + (define-key-after groups-map [filters-to-filter-group] + '(menu-item "Create filter group from current filters..." + ibuffer-filters-to-filter-group + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) + (define-key-after groups-map [forward-filter-group] + '(menu-item "Move point to the next filter group" + ibuffer-forward-filter-group)) + (define-key-after groups-map [backward-filter-group] + '(menu-item "Move point to the previous filter group" + ibuffer-backward-filter-group)) + (define-key-after groups-map [jump-to-filter-group] + '(menu-item "Move point to a specific filter group..." + ibuffer-jump-to-filter-group)) + (define-key-after groups-map [kill-filter-group] + '(menu-item "Kill filter group named..." + ibuffer-kill-filter-group + :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) + (define-key-after groups-map [yank-filter-group] + '(menu-item "Yank last killed filter group before..." + ibuffer-yank-filter-group + :enable (and (featurep 'ibuf-ext) ibuffer-filter-group-kill-ring))) + (define-key-after groups-map [pop-filter-group] + '(menu-item "Remove top filter group" + ibuffer-pop-filter-group + :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) + (define-key-after groups-map [clear-filter-groups] + '(menu-item "Remove all filter groups" + ibuffer-clear-filter-groups + :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) + (define-key-after groups-map [pop-filter-group] + '(menu-item "Decompose filter group..." + ibuffer-pop-filter-group + :help "\"Unmake\" a filter group" + :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) + (define-key-after groups-map [save-filter-groups] + '(menu-item "Save current filter groups permanently..." + ibuffer-save-filter-groups + :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups) + :help "Use a mnemnonic name to store current filter groups")) + (define-key-after groups-map [switch-to-saved-filter-groups] + '(menu-item "Restore permanently saved filters..." + ibuffer-switch-to-saved-filter-groups + :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups) + :help "Replace current filters with a saved stack")) + (define-key-after groups-map [delete-saved-filter-groups] + '(menu-item "Delete permanently saved filter groups..." + ibuffer-delete-saved-filter-groups + :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups))) + (define-key-after groups-map [set-filter-groups-by-mode] + '(menu-item "Set current filter groups to filter by mode" + ibuffer-set-filter-groups-by-mode)) + + groups-map)) -(defvar ibuffer-mode-map nil) -(defvar ibuffer-mode-operate-map nil) -(defvar ibuffer-mode-groups-popup nil) -(unless ibuffer-mode-map - (let ((map (make-sparse-keymap)) - (operate-map (make-sparse-keymap "Operate")) - (groups-map (make-sparse-keymap "Filter Groups"))) +(defvar ibuffer-mode-map + (let ((map (make-keymap))) (define-key map (kbd "0") 'digit-argument) (define-key map (kbd "1") 'digit-argument) (define-key map (kbd "2") 'digit-argument) @@ -545,10 +597,10 @@ directory, like `default-directory'." '(menu-item "View (other frame)" ibuffer-visit-buffer-other-frame)) (define-key-after map [menu-bar view ibuffer-update] '(menu-item "Update" ibuffer-update - :help "Regenerate the list of buffers")) + :help "Regenerate the list of buffers")) (define-key-after map [menu-bar view switch-format] '(menu-item "Switch display format" ibuffer-switch-format - :help "Toggle between available values of `ibuffer-formats'")) + :help "Toggle between available values of `ibuffer-formats'")) (define-key-after map [menu-bar view dashes] '("--")) @@ -562,28 +614,29 @@ directory, like `default-directory'." '(menu-item "Sort by buffer size" ibuffer-do-sort-by-size)) (define-key-after map [menu-bar view sort do-sort-by-alphabetic] '(menu-item "Sort lexicographically" ibuffer-do-sort-by-alphabetic - :help "Sort by the alphabetic order of buffer name")) + :help "Sort by the alphabetic order of buffer name")) (define-key-after map [menu-bar view sort do-sort-by-recency] '(menu-item "Sort by view time" ibuffer-do-sort-by-recency - :help "Sort by the last time the buffer was displayed")) + :help "Sort by the last time the buffer was displayed")) (define-key-after map [menu-bar view sort dashes] '("--")) (define-key-after map [menu-bar view sort invert-sorting] '(menu-item "Reverse sorting order" ibuffer-invert-sorting)) (define-key-after map [menu-bar view sort toggle-sorting-mode] '(menu-item "Switch sorting mode" ibuffer-toggle-sorting-mode - :help "Switch between the various sorting criteria")) + :help "Switch between the various sorting criteria")) (define-key-after map [menu-bar view filter] (cons "Filter" (make-sparse-keymap "Filter"))) (define-key-after map [menu-bar view filter filter-disable] '(menu-item "Disable all filtering" ibuffer-filter-disable - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) (define-key-after map [menu-bar view filter filter-by-mode] '(menu-item "Add filter by major mode..." ibuffer-filter-by-mode)) (define-key-after map [menu-bar view filter filter-by-mode] - '(menu-item "Add filter by major mode in use..." ibuffer-filter-by-used-mode)) + '(menu-item "Add filter by major mode in use..." + ibuffer-filter-by-used-mode)) (define-key-after map [menu-bar view filter filter-by-name] '(menu-item "Add filter by buffer name..." ibuffer-filter-by-name)) (define-key-after map [menu-bar view filter filter-by-filename] @@ -591,158 +644,112 @@ directory, like `default-directory'." (define-key-after map [menu-bar view filter filter-by-size-lt] '(menu-item "Add filter by size less than..." ibuffer-filter-by-size-lt)) (define-key-after map [menu-bar view filter filter-by-size-gt] - '(menu-item "Add filter by size greater than..." ibuffer-filter-by-size-gt)) + '(menu-item "Add filter by size greater than..." + ibuffer-filter-by-size-gt)) (define-key-after map [menu-bar view filter filter-by-content] - '(menu-item "Add filter by content (regexp)..." ibuffer-filter-by-content)) + '(menu-item "Add filter by content (regexp)..." + ibuffer-filter-by-content)) (define-key-after map [menu-bar view filter filter-by-predicate] - '(menu-item "Add filter by Lisp predicate..." ibuffer-filter-by-predicate)) + '(menu-item "Add filter by Lisp predicate..." + ibuffer-filter-by-predicate)) (define-key-after map [menu-bar view filter pop-filter] '(menu-item "Remove top filter" ibuffer-pop-filter - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) (define-key-after map [menu-bar view filter or-filter] '(menu-item "OR top two filters" ibuffer-or-filter - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers - (cdr ibuffer-filtering-qualifiers)) - :help "Create a new filter which is the logical OR of the top two filters")) + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers + (cdr ibuffer-filtering-qualifiers)) + :help + "Create a new filter which is the logical OR of the top two filters")) (define-key-after map [menu-bar view filter negate-filter] '(menu-item "Negate top filter" ibuffer-negate-filter - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) (define-key-after map [menu-bar view filter decompose-filter] '(menu-item "Decompose top filter" ibuffer-decompose-filter - :enable (and (featurep 'ibuf-ext) (memq (car ibuffer-filtering-qualifiers) '(or saved not))) - :help "Break down a complex filter like OR or NOT")) + :enable (and (featurep 'ibuf-ext) + (memq (car ibuffer-filtering-qualifiers) '(or saved not))) + :help "Break down a complex filter like OR or NOT")) (define-key-after map [menu-bar view filter exchange-filters] '(menu-item "Swap top two filters" ibuffer-exchange-filters - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers - (cdr ibuffer-filtering-qualifiers)))) + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers + (cdr ibuffer-filtering-qualifiers)))) (define-key-after map [menu-bar view filter save-filters] '(menu-item "Save current filters permanently..." ibuffer-save-filters - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) - :help "Use a mnemnonic name to store current filter stack")) + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) + :help "Use a mnemnonic name to store current filter stack")) (define-key-after map [menu-bar view filter switch-to-saved-filters] - '(menu-item "Restore permanently saved filters..." ibuffer-switch-to-saved-filters - :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters) - :help "Replace current filters with a saved stack")) + '(menu-item "Restore permanently saved filters..." + ibuffer-switch-to-saved-filters + :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters) + :help "Replace current filters with a saved stack")) (define-key-after map [menu-bar view filter add-saved-filters] - '(menu-item "Add to permanently saved filters..." ibuffer-add-saved-filters - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) - :help "Include already saved stack with current filters")) + '(menu-item "Add to permanently saved filters..." + ibuffer-add-saved-filters + :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) + :help "Include already saved stack with current filters")) (define-key-after map [menu-bar view filter delete-saved-filters] '(menu-item "Delete permanently saved filters..." - ibuffer-delete-saved-filters - :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters))) - - ;; Filter groups - - (define-key-after groups-map [filters-to-filter-group] - '(menu-item "Create filter group from current filters..." - ibuffer-filters-to-filter-group - :enable (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers))) - (define-key-after groups-map [forward-filter-group] - '(menu-item "Move point to the next filter group" - ibuffer-forward-filter-group)) - (define-key-after groups-map [backward-filter-group] - '(menu-item "Move point to the previous filter group" - ibuffer-backward-filter-group)) - (define-key-after groups-map [jump-to-filter-group] - '(menu-item "Move point to a specific filter group..." - ibuffer-jump-to-filter-group)) - (define-key-after groups-map [kill-filter-group] - '(menu-item "Kill filter group named..." - ibuffer-kill-filter-group - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) - (define-key-after groups-map [yank-filter-group] - '(menu-item "Yank last killed filter group before..." - ibuffer-yank-filter-group - :enable (and (featurep 'ibuf-ext) ibuffer-filter-group-kill-ring))) - (define-key-after groups-map [pop-filter-group] - '(menu-item "Remove top filter group" - ibuffer-pop-filter-group - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) - (define-key-after groups-map [clear-filter-groups] - '(menu-item "Remove all filter groups" - ibuffer-clear-filter-groups - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) - (define-key-after groups-map [pop-filter-group] - '(menu-item "Decompose filter group..." - ibuffer-pop-filter-group - :help "\"Unmake\" a filter group" - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups))) - (define-key-after groups-map [save-filter-groups] - '(menu-item "Save current filter groups permanently..." - ibuffer-save-filter-groups - :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups) - :help "Use a mnemnonic name to store current filter groups")) - (define-key-after groups-map [switch-to-saved-filter-groups] - '(menu-item "Restore permanently saved filters..." - ibuffer-switch-to-saved-filter-groups - :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups) - :help "Replace current filters with a saved stack")) - (define-key-after groups-map [delete-saved-filter-groups] - '(menu-item "Delete permanently saved filter groups..." - ibuffer-delete-saved-filter-groups - :enable (and (featurep 'ibuf-ext) ibuffer-saved-filter-groups))) - (define-key-after groups-map [set-filter-groups-by-mode] - '(menu-item "Set current filter groups to filter by mode" - ibuffer-set-filter-groups-by-mode)) + ibuffer-delete-saved-filters + :enable (and (featurep 'ibuf-ext) ibuffer-saved-filters))) (define-key-after map [menu-bar view filter-groups] - (cons "Filter Groups" groups-map)) + (cons "Filter Groups" ibuffer-mode-groups-popup)) (define-key-after map [menu-bar view dashes2] '("--")) (define-key-after map [menu-bar view diff-with-file] '(menu-item "Diff with file" ibuffer-diff-with-file - :help "View the differences between this buffer and its file")) + :help "View the differences between this buffer and its file")) (define-key-after map [menu-bar view auto-mode] '(menu-item "Toggle Auto Mode" ibuffer-auto-mode - :help "Attempt to automatically update the Ibuffer buffer")) + :help "Attempt to automatically update the Ibuffer buffer")) (define-key-after map [menu-bar view customize] '(menu-item "Customize Ibuffer" ibuffer-customize - :help "Use Custom to customize Ibuffer")) + :help "Use Custom to customize Ibuffer")) (define-key-after map [menu-bar mark] (cons "Mark" (make-sparse-keymap "Mark"))) (define-key-after map [menu-bar mark toggle-marks] '(menu-item "Toggle marks" ibuffer-toggle-marks - :help "Unmark marked buffers, and mark unmarked buffers")) + :help "Unmark marked buffers, and mark unmarked buffers")) (define-key-after map [menu-bar mark mark-forward] '(menu-item "Mark" ibuffer-mark-forward - :help "Mark the buffer at point")) + :help "Mark the buffer at point")) (define-key-after map [menu-bar mark unmark-forward] '(menu-item "Unmark" ibuffer-unmark-forward - :help "Unmark the buffer at point")) + :help "Unmark the buffer at point")) (define-key-after map [menu-bar mark mark-by-mode] '(menu-item "Mark by mode..." ibuffer-mark-by-mode - :help "Mark all buffers in a particular major mode")) + :help "Mark all buffers in a particular major mode")) (define-key-after map [menu-bar mark mark-modified-buffers] '(menu-item "Mark modified buffers" ibuffer-mark-modified-buffers - :help "Mark all buffers which have been modified")) + :help "Mark all buffers which have been modified")) (define-key-after map [menu-bar mark mark-unsaved-buffers] '(menu-item "Mark unsaved buffers" ibuffer-mark-unsaved-buffers - :help "Mark all buffers which have a file and are modified")) + :help "Mark all buffers which have a file and are modified")) (define-key-after map [menu-bar mark mark-read-only-buffers] '(menu-item "Mark read-only buffers" ibuffer-mark-read-only-buffers - :help "Mark all buffers which are read-only")) + :help "Mark all buffers which are read-only")) (define-key-after map [menu-bar mark mark-special-buffers] '(menu-item "Mark special buffers" ibuffer-mark-special-buffers - :help "Mark all buffers whose name begins with a *")) + :help "Mark all buffers whose name begins with a *")) (define-key-after map [menu-bar mark mark-dired-buffers] '(menu-item "Mark dired buffers" ibuffer-mark-dired-buffers - :help "Mark buffers in dired-mode")) + :help "Mark buffers in dired-mode")) (define-key-after map [menu-bar mark mark-dissociated-buffers] '(menu-item "Mark dissociated buffers" ibuffer-mark-dissociated-buffers - :help "Mark buffers with a non-existent associated file")) + :help "Mark buffers with a non-existent associated file")) (define-key-after map [menu-bar mark mark-help-buffers] '(menu-item "Mark help buffers" ibuffer-mark-help-buffers - :help "Mark buffers in help-mode")) + :help "Mark buffers in help-mode")) (define-key-after map [menu-bar mark mark-compressed-file-buffers] - '(menu-item "Mark compressed file buffers" ibuffer-mark-compressed-file-buffers - :help "Mark buffers which have a file that is compressed")) + '(menu-item "Mark compressed file buffers" + ibuffer-mark-compressed-file-buffers + :help "Mark buffers which have a file that is compressed")) (define-key-after map [menu-bar mark mark-old-buffers] '(menu-item "Mark old buffers" ibuffer-mark-old-buffers - :help "Mark buffers which have not been viewed recently")) + :help "Mark buffers which have not been viewed recently")) (define-key-after map [menu-bar mark unmark-all] '(menu-item "Unmark All" ibuffer-unmark-all)) @@ -751,16 +758,19 @@ directory, like `default-directory'." (define-key-after map [menu-bar mark mark-by-name-regexp] '(menu-item "Mark by buffer name (regexp)..." ibuffer-mark-by-name-regexp - :help "Mark buffers whose name matches a regexp")) + :help "Mark buffers whose name matches a regexp")) (define-key-after map [menu-bar mark mark-by-mode-regexp] '(menu-item "Mark by major mode (regexp)..." ibuffer-mark-by-mode-regexp - :help "Mark buffers whose major mode name matches a regexp")) + :help "Mark buffers whose major mode name matches a regexp")) (define-key-after map [menu-bar mark mark-by-file-name-regexp] - '(menu-item "Mark by file name (regexp)..." ibuffer-mark-by-file-name-regexp - :help "Mark buffers whose file name matches a regexp")) + '(menu-item "Mark by file name (regexp)..." + ibuffer-mark-by-file-name-regexp + :help "Mark buffers whose file name matches a regexp")) - ;; Operate map is added later + map)) +(defvar ibuffer-mode-operate-map + (let ((operate-map (make-sparse-keymap "Operate"))) (define-key-after operate-map [do-view] '(menu-item "View" ibuffer-do-view)) (define-key-after operate-map [do-view-other-frame] @@ -769,47 +779,45 @@ directory, like `default-directory'." '(menu-item "Save" ibuffer-do-save)) (define-key-after operate-map [do-replace-regexp] '(menu-item "Replace (regexp)..." ibuffer-do-replace-regexp - :help "Replace text inside marked buffers")) + :help "Replace text inside marked buffers")) (define-key-after operate-map [do-query-replace] '(menu-item "Query Replace..." ibuffer-do-query-replace - :help "Replace text in marked buffers, asking each time")) + :help "Replace text in marked buffers, asking each time")) (define-key-after operate-map [do-query-replace-regexp] '(menu-item "Query Replace (regexp)..." ibuffer-do-query-replace-regexp - :help "Replace text in marked buffers by regexp, asking each time")) + :help "Replace text in marked buffers by regexp, asking each time")) (define-key-after operate-map [do-print] '(menu-item "Print" ibuffer-do-print)) (define-key-after operate-map [do-toggle-modified] '(menu-item "Toggle modification flag" ibuffer-do-toggle-modified)) (define-key-after operate-map [do-revert] '(menu-item "Revert" ibuffer-do-revert - :help "Revert marked buffers to their associated file")) + :help "Revert marked buffers to their associated file")) (define-key-after operate-map [do-rename-uniquely] '(menu-item "Rename Uniquely" ibuffer-do-rename-uniquely - :help "Rename marked buffers to a new, unique name")) + :help "Rename marked buffers to a new, unique name")) (define-key-after operate-map [do-delete] '(menu-item "Kill" ibuffer-do-delete)) (define-key-after operate-map [do-occur] '(menu-item "List lines matching..." ibuffer-do-occur - :help "View all lines in marked buffers matching a regexp")) + :help "View all lines in marked buffers matching a regexp")) (define-key-after operate-map [do-shell-command-pipe] '(menu-item "Pipe to shell command..." ibuffer-do-shell-command-pipe - :help "For each marked buffer, send its contents to a shell command")) + :help "For each marked buffer, send its contents to a shell command")) (define-key-after operate-map [do-shell-command-pipe-replace] '(menu-item "Pipe to shell command (replace)..." ibuffer-do-shell-command-pipe-replace - :help "For each marked buffer, replace its contents with output of shell command")) + :help "For each marked buffer, replace its contents with output of shell command")) (define-key-after operate-map [do-shell-command-file] '(menu-item "Shell command on buffer's file..." ibuffer-do-shell-command-file - :help "For each marked buffer, run a shell command with its file as argument")) + :help "For each marked buffer, run a shell command with its file as argument")) (define-key-after operate-map [do-eval] '(menu-item "Eval..." ibuffer-do-eval - :help "Evaluate a Lisp form in each marked buffer")) + :help "Evaluate a Lisp form in each marked buffer")) (define-key-after operate-map [do-view-and-eval] '(menu-item "Eval (viewing buffer)..." ibuffer-do-view-and-eval - :help "Evaluate a Lisp form in each marked buffer while viewing it")) + :help "Evaluate a Lisp form in each marked buffer while viewing it")) - (setq ibuffer-mode-map map - ibuffer-mode-operate-map operate-map - ibuffer-mode-groups-popup (copy-keymap groups-map)))) + operate-map)) (define-key ibuffer-mode-groups-popup [kill-filter-group] '(menu-item "Kill filter group" @@ -1559,9 +1567,8 @@ If point is on a group name, this function operates on that group." from-end-p)) (setq strlen (length str)) (setq str - ,(ibuffer-compile-make-eliding-form 'str - elide - from-end-p))))) + ,(ibuffer-compile-make-eliding-form + 'str elide from-end-p))))) ;; Now, put these forms together with the rest of the code. (let ((callform ;; Is this an "inline" column? This means we have @@ -1575,16 +1582,18 @@ If point is on a group name, this function operates on that group." ;; You're not expected to understand this. Hell, I ;; don't even understand it, and I wrote it five ;; minutes ago. - (insertgenfn (ibuffer-aif (get sym 'ibuffer-column-summarizer) - ;; I really, really wish Emacs Lisp had closures. - (lambda (arg sym) - `(insert - (let ((ret ,arg)) - (put ',sym 'ibuffer-column-summary - (cons ret (get ',sym 'ibuffer-column-summary))) - ret))) - (lambda (arg sym) - `(insert ,arg)))) + (insertgenfn + (ibuffer-aif (get sym 'ibuffer-column-summarizer) + ;; I really, really wish Emacs Lisp had closures. + (lambda (arg sym) + `(insert + (let ((ret ,arg)) + (put ',sym 'ibuffer-column-summary + (cons ret (get ',sym + 'ibuffer-column-summary))) + ret))) + (lambda (arg sym) + `(insert ,arg)))) (mincompform `(< strlen ,(if (integerp min) min 'min))) @@ -1617,7 +1626,8 @@ If point is on a group name, this function operates on that group." `(strlen (length str)))) outforms) (setq outforms - (append outforms (list (funcall insertgenfn 'str sym))))) + (append outforms + (list (funcall insertgenfn 'str sym))))) ;; The simple case; just insert the string. (push (funcall insertgenfn callform sym) outforms)) ;; Finally, return a `let' form which binds the @@ -2638,7 +2648,7 @@ will be inserted before the group at point." ;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group ;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group ;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode -;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "f163e17664a89a6f0aa2b15bfaaa65a4") +;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "eb3de21aef70e4ca75f611f1c3c56aa1") ;;; Generated autoloads from ibuf-ext.el (autoload 'ibuffer-auto-mode "ibuf-ext" "\ diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 8c26b69956..8fa6963b3d 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -2194,15 +2194,15 @@ matching tag will be marked in the dired buffer." Track this in associated dired buffer if `image-dired-track-movement' is non-nil." (interactive "e") - (let (file) - (mouse-set-point event) - (goto-char (posn-point (event-end event))) - (setq file (image-dired-original-file-name)) - (if image-dired-track-movement - (image-dired-track-original-file)) - (image-dired-create-display-image-buffer) - (display-buffer image-dired-display-image-buffer) - (image-dired-display-image file))) + (mouse-set-point event) + (goto-char (posn-point (event-end event))) + (let ((file (image-dired-original-file-name))) + (when file + (if image-dired-track-movement + (image-dired-track-original-file)) + (image-dired-create-display-image-buffer) + (display-buffer image-dired-display-image-buffer) + (image-dired-display-image file)))) (defun image-dired-mouse-select-thumbnail (event) "Use mouse EVENT to select thumbnail image. diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 74fd96e8ad..190ca08722 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -305,8 +305,7 @@ This variable is used to display the current image type in the mode line.") (defvar image-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "q" 'quit-window) + (set-keymap-parent map special-mode-map) (define-key map "\C-c\C-c" 'image-toggle-display) (define-key map (kbd "SPC") 'image-scroll-up) (define-key map (kbd "DEL") 'image-scroll-down) @@ -385,7 +384,6 @@ to toggle between display as an image and display as text." (funcall (if (called-interactively-p 'any) 'error 'message) "Cannot display image: %s" (cdr err))))) - ;;;###autoload (define-minor-mode image-minor-mode "Toggle Image minor mode. diff --git a/lisp/international/mule-util.el b/lisp/international/mule-util.el index 59496266ea..ef09cdda2d 100644 --- a/lisp/international/mule-util.el +++ b/lisp/international/mule-util.el @@ -313,7 +313,7 @@ Optional 5th argument NIL-FOR-TOO-LONG non-nil means return nil ;;;###autoload (defmacro with-coding-priority (coding-systems &rest body) "Execute BODY like `progn' with CODING-SYSTEMS at the front of priority list. -CODING-SYSTEMS is a list of coding systems. See `set-coding-priority'. +CODING-SYSTEMS is a list of coding systems. See `set-coding-system-priority'. This affects the implicit sorting of lists of coding sysems returned by operations such as `find-coding-systems-region'." (let ((current (make-symbol "current"))) diff --git a/lisp/international/quail.el b/lisp/international/quail.el index c5842740db..2174beb19c 100644 --- a/lisp/international/quail.el +++ b/lisp/international/quail.el @@ -662,7 +662,7 @@ This layout is almost the same as that of VT100, ") '("pc105-uk" . "\ \ -`\2541!2\"3\2434$5%6^7&8*9(0)-_=+ \ +`\2541!2\"3\2434$5%6^7&8*9(0)-_=+ \ qQwWeErRtTyYuUiIoOpP[{]} \ aAsSdDfFgGhHjJkKlL;:'@#~ \ \\|zZxXcCvVbBnNmM,<.>/? \ diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 689120c0f8..6f4bed3ec5 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -916,34 +916,35 @@ without repeating the prefix." (defvar kmacro-step-edit-help) ;; kmacro step edit help enabled (defvar kmacro-step-edit-num-input-keys) ;; to ignore duplicate pre-command hook -(defvar kmacro-step-edit-map (make-sparse-keymap) +(defvar kmacro-step-edit-map + (let ((map (make-sparse-keymap))) + ;; query-replace-map answers include: `act', `skip', `act-and-show', + ;; `exit', `act-and-exit', `edit', `delete-and-edit', `recenter', + ;; `automatic', `backup', `exit-prefix', and `help'.") + ;; Also: `quit', `edit-replacement' + + (set-keymap-parent map query-replace-map) + + (define-key map "\t" 'act-repeat) + (define-key map [tab] 'act-repeat) + (define-key map "\C-k" 'skip-rest) + (define-key map "c" 'automatic) + (define-key map "f" 'skip-keep) + (define-key map "q" 'quit) + (define-key map "d" 'skip) + (define-key map "\C-d" 'skip) + (define-key map "i" 'insert) + (define-key map "I" 'insert-1) + (define-key map "r" 'replace) + (define-key map "R" 'replace-1) + (define-key map "a" 'append) + (define-key map "A" 'append-end) + map) "Keymap that defines the responses to questions in `kmacro-step-edit-macro'. This keymap is an extension to the `query-replace-map', allowing the following additional answers: `insert', `insert-1', `replace', `replace-1', `append', `append-end', `act-repeat', `skip-end', `skip-keep'.") -;; query-replace-map answers include: `act', `skip', `act-and-show', -;; `exit', `act-and-exit', `edit', `delete-and-edit', `recenter', -;; `automatic', `backup', `exit-prefix', and `help'.") -;; Also: `quit', `edit-replacement' - -(set-keymap-parent kmacro-step-edit-map query-replace-map) - -(define-key kmacro-step-edit-map "\t" 'act-repeat) -(define-key kmacro-step-edit-map [tab] 'act-repeat) -(define-key kmacro-step-edit-map "\C-k" 'skip-rest) -(define-key kmacro-step-edit-map "c" 'automatic) -(define-key kmacro-step-edit-map "f" 'skip-keep) -(define-key kmacro-step-edit-map "q" 'quit) -(define-key kmacro-step-edit-map "d" 'skip) -(define-key kmacro-step-edit-map "\C-d" 'skip) -(define-key kmacro-step-edit-map "i" 'insert) -(define-key kmacro-step-edit-map "I" 'insert-1) -(define-key kmacro-step-edit-map "r" 'replace) -(define-key kmacro-step-edit-map "R" 'replace-1) -(define-key kmacro-step-edit-map "a" 'append) -(define-key kmacro-step-edit-map "A" 'append-end) - (defvar kmacro-step-edit-prefix-commands '(universal-argument universal-argument-more universal-argument-minus digit-argument negative-argument) diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index a621647bcf..9aac041e8b 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -340,18 +340,6 @@ usually do not have translators to read other languages for them.\n\n") (string-equal (buffer-substring-no-properties (point-min) (point)) report-emacs-bug-orig-text) (error "No text entered in bug report")) - ;; Check the buffer contents and reject non-English letters. - ;; FIXME message-mode probably does this anyway. - (goto-char (point-min)) - (skip-chars-forward "\0-\177") - (unless (eobp) - (if (or report-emacs-bug-no-confirmation - (y-or-n-p "Convert non-ASCII letters to hexadecimal? ")) - (while (progn (skip-chars-forward "\0-\177") - (not (eobp))) - (let ((ch (following-char))) - (delete-char 1) - (insert (format "=%02x" ch)))))) ;; The last warning for novice users. (unless (or report-emacs-bug-no-confirmation diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7e1cbe4ea8..7e44ae22e1 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -4418,7 +4418,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order. ;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic ;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels -;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "76a7ae570a4fa96a9233d0276f52f515") +;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "adad96c9eb13cae4bae0769f731d8784") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index e0f40afc0d..1d5e062fe2 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -64,7 +64,196 @@ Setting this option to nil might speed up the generation of summaries." "Overlay used to highlight the current message in the Rmail summary.") (put 'rmail-summary-overlay 'permanent-local t) -(defvar rmail-summary-mode-map nil +(defvar rmail-summary-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map [mouse-2] 'rmail-summary-mouse-goto-message) + (define-key map "a" 'rmail-summary-add-label) + (define-key map "b" 'rmail-summary-bury) + (define-key map "c" 'rmail-summary-continue) + (define-key map "d" 'rmail-summary-delete-forward) + (define-key map "\C-d" 'rmail-summary-delete-backward) + (define-key map "e" 'rmail-summary-edit-current-message) + (define-key map "f" 'rmail-summary-forward) + (define-key map "g" 'rmail-summary-get-new-mail) + (define-key map "h" 'rmail-summary) + (define-key map "i" 'rmail-summary-input) + (define-key map "j" 'rmail-summary-goto-msg) + (define-key map "\C-m" 'rmail-summary-goto-msg) + (define-key map "k" 'rmail-summary-kill-label) + (define-key map "l" 'rmail-summary-by-labels) + (define-key map "\e\C-h" 'rmail-summary) + (define-key map "\e\C-l" 'rmail-summary-by-labels) + (define-key map "\e\C-r" 'rmail-summary-by-recipients) + (define-key map "\e\C-s" 'rmail-summary-by-regexp) + ;; `f' for "from". + (define-key map "\e\C-f" 'rmail-summary-by-senders) + (define-key map "\e\C-t" 'rmail-summary-by-topic) + (define-key map "m" 'rmail-summary-mail) + (define-key map "\M-m" 'rmail-summary-retry-failure) + (define-key map "n" 'rmail-summary-next-msg) + (define-key map "\en" 'rmail-summary-next-all) + (define-key map "\e\C-n" 'rmail-summary-next-labeled-message) + (define-key map "o" 'rmail-summary-output) + (define-key map "\C-o" 'rmail-summary-output-as-seen) + (define-key map "p" 'rmail-summary-previous-msg) + (define-key map "\ep" 'rmail-summary-previous-all) + (define-key map "\e\C-p" 'rmail-summary-previous-labeled-message) + (define-key map "q" 'rmail-summary-quit) + (define-key map "Q" 'rmail-summary-wipe) + (define-key map "r" 'rmail-summary-reply) + (define-key map "s" 'rmail-summary-expunge-and-save) + ;; See rms's comment in rmail.el + ;; (define-key map "\er" 'rmail-summary-search-backward) + (define-key map "\es" 'rmail-summary-search) + (define-key map "t" 'rmail-summary-toggle-header) + (define-key map "u" 'rmail-summary-undelete) + (define-key map "\M-u" 'rmail-summary-undelete-many) + (define-key map "x" 'rmail-summary-expunge) + (define-key map "w" 'rmail-summary-output-body) + (define-key map "v" 'rmail-mime) + (define-key map "." 'rmail-summary-beginning-of-message) + (define-key map "/" 'rmail-summary-end-of-message) + (define-key map "<" 'rmail-summary-first-message) + (define-key map ">" 'rmail-summary-last-message) + (define-key map " " 'rmail-summary-scroll-msg-up) + (define-key map "\177" 'rmail-summary-scroll-msg-down) + (define-key map "?" 'describe-mode) + (define-key map "\C-c\C-n" 'rmail-summary-next-same-subject) + (define-key map "\C-c\C-p" 'rmail-summary-previous-same-subject) + (define-key map "\C-c\C-s\C-d" 'rmail-summary-sort-by-date) + (define-key map "\C-c\C-s\C-s" 'rmail-summary-sort-by-subject) + (define-key map "\C-c\C-s\C-a" 'rmail-summary-sort-by-author) + (define-key map "\C-c\C-s\C-r" 'rmail-summary-sort-by-recipient) + (define-key map "\C-c\C-s\C-c" 'rmail-summary-sort-by-correspondent) + (define-key map "\C-c\C-s\C-l" 'rmail-summary-sort-by-lines) + (define-key map "\C-c\C-s\C-k" 'rmail-summary-sort-by-labels) + (define-key map "\C-x\C-s" 'rmail-summary-save-buffer) + + ;; Menu bar bindings. + + (define-key map [menu-bar] (make-sparse-keymap)) + + (define-key map [menu-bar classify] + (cons "Classify" (make-sparse-keymap "Classify"))) + + (define-key map [menu-bar classify output-menu] + '("Output (Rmail Menu)..." . rmail-summary-output-menu)) + + (define-key map [menu-bar classify input-menu] + '("Input Rmail File (menu)..." . rmail-input-menu)) + + (define-key map [menu-bar classify input-menu] + '(nil)) + + (define-key map [menu-bar classify output-menu] + '(nil)) + + (define-key map [menu-bar classify output-body] + '("Output body..." . rmail-summary-output-body)) + + (define-key map [menu-bar classify output-inbox] + '("Output..." . rmail-summary-output)) + + (define-key map [menu-bar classify output] + '("Output as seen..." . rmail-summary-output-as-seen)) + + (define-key map [menu-bar classify kill-label] + '("Kill Label..." . rmail-summary-kill-label)) + + (define-key map [menu-bar classify add-label] + '("Add Label..." . rmail-summary-add-label)) + + (define-key map [menu-bar summary] + (cons "Summary" (make-sparse-keymap "Summary"))) + + (define-key map [menu-bar summary senders] + '("By Senders..." . rmail-summary-by-senders)) + + (define-key map [menu-bar summary labels] + '("By Labels..." . rmail-summary-by-labels)) + + (define-key map [menu-bar summary recipients] + '("By Recipients..." . rmail-summary-by-recipients)) + + (define-key map [menu-bar summary topic] + '("By Topic..." . rmail-summary-by-topic)) + + (define-key map [menu-bar summary regexp] + '("By Regexp..." . rmail-summary-by-regexp)) + + (define-key map [menu-bar summary all] + '("All" . rmail-summary)) + + (define-key map [menu-bar mail] + (cons "Mail" (make-sparse-keymap "Mail"))) + + (define-key map [menu-bar mail rmail-summary-get-new-mail] + '("Get New Mail" . rmail-summary-get-new-mail)) + + (define-key map [menu-bar mail lambda] + '("----")) + + (define-key map [menu-bar mail continue] + '("Continue" . rmail-summary-continue)) + + (define-key map [menu-bar mail resend] + '("Re-send..." . rmail-summary-resend)) + + (define-key map [menu-bar mail forward] + '("Forward" . rmail-summary-forward)) + + (define-key map [menu-bar mail retry] + '("Retry" . rmail-summary-retry-failure)) + + (define-key map [menu-bar mail reply] + '("Reply" . rmail-summary-reply)) + + (define-key map [menu-bar mail mail] + '("Mail" . rmail-summary-mail)) + + (define-key map [menu-bar delete] + (cons "Delete" (make-sparse-keymap "Delete"))) + + (define-key map [menu-bar delete expunge/save] + '("Expunge/Save" . rmail-summary-expunge-and-save)) + + (define-key map [menu-bar delete expunge] + '("Expunge" . rmail-summary-expunge)) + + (define-key map [menu-bar delete undelete] + '("Undelete" . rmail-summary-undelete)) + + (define-key map [menu-bar delete delete] + '("Delete" . rmail-summary-delete-forward)) + + (define-key map [menu-bar move] + (cons "Move" (make-sparse-keymap "Move"))) + + (define-key map [menu-bar move search-back] + '("Search Back..." . rmail-summary-search-backward)) + + (define-key map [menu-bar move search] + '("Search..." . rmail-summary-search)) + + (define-key map [menu-bar move previous] + '("Previous Nondeleted" . rmail-summary-previous-msg)) + + (define-key map [menu-bar move next] + '("Next Nondeleted" . rmail-summary-next-msg)) + + (define-key map [menu-bar move last] + '("Last" . rmail-summary-last-message)) + + (define-key map [menu-bar move first] + '("First" . rmail-summary-first-message)) + + (define-key map [menu-bar move previous] + '("Previous" . rmail-summary-previous-all)) + + (define-key map [menu-bar move next] + '("Next" . rmail-summary-next-all)) + map) "Keymap used in Rmail summary mode.") ;; Entry points for making a summary buffer. @@ -990,207 +1179,6 @@ Search, the `unseen' attribute is restored.") (save-excursion (switch-to-buffer rmail-buffer) (save-buffer)))) - - -(if rmail-summary-mode-map - nil - (setq rmail-summary-mode-map (make-keymap)) - (suppress-keymap rmail-summary-mode-map) - - (define-key rmail-summary-mode-map [mouse-2] 'rmail-summary-mouse-goto-message) - (define-key rmail-summary-mode-map "a" 'rmail-summary-add-label) - (define-key rmail-summary-mode-map "b" 'rmail-summary-bury) - (define-key rmail-summary-mode-map "c" 'rmail-summary-continue) - (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward) - (define-key rmail-summary-mode-map "\C-d" 'rmail-summary-delete-backward) - (define-key rmail-summary-mode-map "e" 'rmail-summary-edit-current-message) - (define-key rmail-summary-mode-map "f" 'rmail-summary-forward) - (define-key rmail-summary-mode-map "g" 'rmail-summary-get-new-mail) - (define-key rmail-summary-mode-map "h" 'rmail-summary) - (define-key rmail-summary-mode-map "i" 'rmail-summary-input) - (define-key rmail-summary-mode-map "j" 'rmail-summary-goto-msg) - (define-key rmail-summary-mode-map "\C-m" 'rmail-summary-goto-msg) - (define-key rmail-summary-mode-map "k" 'rmail-summary-kill-label) - (define-key rmail-summary-mode-map "l" 'rmail-summary-by-labels) - (define-key rmail-summary-mode-map "\e\C-h" 'rmail-summary) - (define-key rmail-summary-mode-map "\e\C-l" 'rmail-summary-by-labels) - (define-key rmail-summary-mode-map "\e\C-r" 'rmail-summary-by-recipients) - (define-key rmail-summary-mode-map "\e\C-s" 'rmail-summary-by-regexp) - ;; `f' for "from". - (define-key rmail-summary-mode-map "\e\C-f" 'rmail-summary-by-senders) - (define-key rmail-summary-mode-map "\e\C-t" 'rmail-summary-by-topic) - (define-key rmail-summary-mode-map "m" 'rmail-summary-mail) - (define-key rmail-summary-mode-map "\M-m" 'rmail-summary-retry-failure) - (define-key rmail-summary-mode-map "n" 'rmail-summary-next-msg) - (define-key rmail-summary-mode-map "\en" 'rmail-summary-next-all) - (define-key rmail-summary-mode-map "\e\C-n" 'rmail-summary-next-labeled-message) - (define-key rmail-summary-mode-map "o" 'rmail-summary-output) - (define-key rmail-summary-mode-map "\C-o" 'rmail-summary-output-as-seen) - (define-key rmail-summary-mode-map "p" 'rmail-summary-previous-msg) - (define-key rmail-summary-mode-map "\ep" 'rmail-summary-previous-all) - (define-key rmail-summary-mode-map "\e\C-p" 'rmail-summary-previous-labeled-message) - (define-key rmail-summary-mode-map "q" 'rmail-summary-quit) - (define-key rmail-summary-mode-map "Q" 'rmail-summary-wipe) - (define-key rmail-summary-mode-map "r" 'rmail-summary-reply) - (define-key rmail-summary-mode-map "s" 'rmail-summary-expunge-and-save) - ;; See rms's comment in rmail.el -;;; (define-key rmail-summary-mode-map "\er" 'rmail-summary-search-backward) - (define-key rmail-summary-mode-map "\es" 'rmail-summary-search) - (define-key rmail-summary-mode-map "t" 'rmail-summary-toggle-header) - (define-key rmail-summary-mode-map "u" 'rmail-summary-undelete) - (define-key rmail-summary-mode-map "\M-u" 'rmail-summary-undelete-many) - (define-key rmail-summary-mode-map "x" 'rmail-summary-expunge) - (define-key rmail-summary-mode-map "w" 'rmail-summary-output-body) - (define-key rmail-summary-mode-map "v" 'rmail-mime) - (define-key rmail-summary-mode-map "." 'rmail-summary-beginning-of-message) - (define-key rmail-summary-mode-map "/" 'rmail-summary-end-of-message) - (define-key rmail-summary-mode-map "<" 'rmail-summary-first-message) - (define-key rmail-summary-mode-map ">" 'rmail-summary-last-message) - (define-key rmail-summary-mode-map " " 'rmail-summary-scroll-msg-up) - (define-key rmail-summary-mode-map "\177" 'rmail-summary-scroll-msg-down) - (define-key rmail-summary-mode-map "?" 'describe-mode) - (define-key rmail-summary-mode-map "\C-c\C-n" 'rmail-summary-next-same-subject) - (define-key rmail-summary-mode-map "\C-c\C-p" 'rmail-summary-previous-same-subject) - (define-key rmail-summary-mode-map "\C-c\C-s\C-d" - 'rmail-summary-sort-by-date) - (define-key rmail-summary-mode-map "\C-c\C-s\C-s" - 'rmail-summary-sort-by-subject) - (define-key rmail-summary-mode-map "\C-c\C-s\C-a" - 'rmail-summary-sort-by-author) - (define-key rmail-summary-mode-map "\C-c\C-s\C-r" - 'rmail-summary-sort-by-recipient) - (define-key rmail-summary-mode-map "\C-c\C-s\C-c" - 'rmail-summary-sort-by-correspondent) - (define-key rmail-summary-mode-map "\C-c\C-s\C-l" - 'rmail-summary-sort-by-lines) - (define-key rmail-summary-mode-map "\C-c\C-s\C-k" - 'rmail-summary-sort-by-labels) - (define-key rmail-summary-mode-map "\C-x\C-s" 'rmail-summary-save-buffer) - ) - -;;; Menu bar bindings. - -(define-key rmail-summary-mode-map [menu-bar] (make-sparse-keymap)) - -(define-key rmail-summary-mode-map [menu-bar classify] - (cons "Classify" (make-sparse-keymap "Classify"))) - -(define-key rmail-summary-mode-map [menu-bar classify output-menu] - '("Output (Rmail Menu)..." . rmail-summary-output-menu)) - -(define-key rmail-summary-mode-map [menu-bar classify input-menu] - '("Input Rmail File (menu)..." . rmail-input-menu)) - -(define-key rmail-summary-mode-map [menu-bar classify input-menu] - '(nil)) - -(define-key rmail-summary-mode-map [menu-bar classify output-menu] - '(nil)) - -(define-key rmail-summary-mode-map [menu-bar classify output-body] - '("Output body..." . rmail-summary-output-body)) - -(define-key rmail-summary-mode-map [menu-bar classify output-inbox] - '("Output..." . rmail-summary-output)) - -(define-key rmail-summary-mode-map [menu-bar classify output] - '("Output as seen..." . rmail-summary-output-as-seen)) - -(define-key rmail-summary-mode-map [menu-bar classify kill-label] - '("Kill Label..." . rmail-summary-kill-label)) - -(define-key rmail-summary-mode-map [menu-bar classify add-label] - '("Add Label..." . rmail-summary-add-label)) - -(define-key rmail-summary-mode-map [menu-bar summary] - (cons "Summary" (make-sparse-keymap "Summary"))) - -(define-key rmail-summary-mode-map [menu-bar summary senders] - '("By Senders..." . rmail-summary-by-senders)) - -(define-key rmail-summary-mode-map [menu-bar summary labels] - '("By Labels..." . rmail-summary-by-labels)) - -(define-key rmail-summary-mode-map [menu-bar summary recipients] - '("By Recipients..." . rmail-summary-by-recipients)) - -(define-key rmail-summary-mode-map [menu-bar summary topic] - '("By Topic..." . rmail-summary-by-topic)) - -(define-key rmail-summary-mode-map [menu-bar summary regexp] - '("By Regexp..." . rmail-summary-by-regexp)) - -(define-key rmail-summary-mode-map [menu-bar summary all] - '("All" . rmail-summary)) - -(define-key rmail-summary-mode-map [menu-bar mail] - (cons "Mail" (make-sparse-keymap "Mail"))) - -(define-key rmail-summary-mode-map [menu-bar mail rmail-summary-get-new-mail] - '("Get New Mail" . rmail-summary-get-new-mail)) - -(define-key rmail-summary-mode-map [menu-bar mail lambda] - '("----")) - -(define-key rmail-summary-mode-map [menu-bar mail continue] - '("Continue" . rmail-summary-continue)) - -(define-key rmail-summary-mode-map [menu-bar mail resend] - '("Re-send..." . rmail-summary-resend)) - -(define-key rmail-summary-mode-map [menu-bar mail forward] - '("Forward" . rmail-summary-forward)) - -(define-key rmail-summary-mode-map [menu-bar mail retry] - '("Retry" . rmail-summary-retry-failure)) - -(define-key rmail-summary-mode-map [menu-bar mail reply] - '("Reply" . rmail-summary-reply)) - -(define-key rmail-summary-mode-map [menu-bar mail mail] - '("Mail" . rmail-summary-mail)) - -(define-key rmail-summary-mode-map [menu-bar delete] - (cons "Delete" (make-sparse-keymap "Delete"))) - -(define-key rmail-summary-mode-map [menu-bar delete expunge/save] - '("Expunge/Save" . rmail-summary-expunge-and-save)) - -(define-key rmail-summary-mode-map [menu-bar delete expunge] - '("Expunge" . rmail-summary-expunge)) - -(define-key rmail-summary-mode-map [menu-bar delete undelete] - '("Undelete" . rmail-summary-undelete)) - -(define-key rmail-summary-mode-map [menu-bar delete delete] - '("Delete" . rmail-summary-delete-forward)) - -(define-key rmail-summary-mode-map [menu-bar move] - (cons "Move" (make-sparse-keymap "Move"))) - -(define-key rmail-summary-mode-map [menu-bar move search-back] - '("Search Back..." . rmail-summary-search-backward)) - -(define-key rmail-summary-mode-map [menu-bar move search] - '("Search..." . rmail-summary-search)) - -(define-key rmail-summary-mode-map [menu-bar move previous] - '("Previous Nondeleted" . rmail-summary-previous-msg)) - -(define-key rmail-summary-mode-map [menu-bar move next] - '("Next Nondeleted" . rmail-summary-next-msg)) - -(define-key rmail-summary-mode-map [menu-bar move last] - '("Last" . rmail-summary-last-message)) - -(define-key rmail-summary-mode-map [menu-bar move first] - '("First" . rmail-summary-first-message)) - -(define-key rmail-summary-mode-map [menu-bar move previous] - '("Previous" . rmail-summary-previous-all)) - -(define-key rmail-summary-mode-map [menu-bar move next] - '("Next" . rmail-summary-next-all)) (defun rmail-summary-mouse-goto-message (event) "Select the message whose summary line you click on." diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 42caeee447..8a33381b61 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -28,11 +28,17 @@ ;;; Code: +;; This is referenced by some code below; it is defined in uniquify.el +(defvar uniquify-buffer-name-style) + +;; From emulation/cua-base.el; used below +(defvar cua-enable-cua-keys) + + ;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key ;; definitions made in loaddefs.el. (or (lookup-key global-map [menu-bar]) (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))) -(defvar menu-bar-help-menu (make-sparse-keymap "Help")) (if (not (featurep 'ns)) ;; Force Help item to come last, after the major mode's own items. @@ -52,149 +58,151 @@ (define-key global-map [menu-bar services] ; set-up in ns-win (cons (purecopy "Services") (make-sparse-keymap "Services")))) -;; If running under GNUstep, "Help" is moved and renamed "Info" (see below). -(or (and (featurep 'ns) - (not (eq system-type 'darwin))) - (define-key global-map [menu-bar help-menu] - (cons (purecopy "Help") menu-bar-help-menu))) - -(defvar menu-bar-tools-menu (make-sparse-keymap "Tools")) -(define-key global-map [menu-bar tools] - (cons (purecopy "Tools") menu-bar-tools-menu)) ;; This definition is just to show what this looks like. ;; It gets modified in place when menu-bar-update-buffers is called. (defvar global-buffers-menu-map (make-sparse-keymap "Buffers")) -(define-key global-map [menu-bar buffer] - (cons (purecopy "Buffers") global-buffers-menu-map)) -(defvar menu-bar-options-menu (make-sparse-keymap "Options")) -(define-key global-map [menu-bar options] - (cons (purecopy "Options") menu-bar-options-menu)) -(defvar menu-bar-edit-menu (make-sparse-keymap "Edit")) -(define-key global-map [menu-bar edit] - (cons (purecopy "Edit") menu-bar-edit-menu)) -(defvar menu-bar-file-menu (make-sparse-keymap "File")) -(define-key global-map [menu-bar file] - (cons (purecopy "File") menu-bar-file-menu)) - -;; Put "Help" menu at the front, called "Info". -(and (featurep 'ns) - (not (eq system-type 'darwin)) - (define-key global-map [menu-bar help-menu] - (cons (purecopy "Info") menu-bar-help-menu))) ;; Only declared obsolete (and only made a proper alias) in 23.3. -(define-obsolete-variable-alias 'menu-bar-files-menu 'menu-bar-file-menu "22.1") - -;; This is referenced by some code below; it is defined in uniquify.el -(defvar uniquify-buffer-name-style) - -;; From emulation/cua-base.el; used below -(defvar cua-enable-cua-keys) +(define-obsolete-variable-alias + 'menu-bar-files-menu 'menu-bar-file-menu "22.1") +(defvar menu-bar-file-menu + (let ((menu (make-sparse-keymap "File"))) + + ;; The "File" menu items + (define-key menu [exit-emacs] + `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal + :help ,(purecopy "Save unsaved buffers, then exit"))) - -;; The "File" menu items -(define-key menu-bar-file-menu [exit-emacs] - `(menu-item ,(purecopy "Quit") save-buffers-kill-terminal - :help ,(purecopy "Save unsaved buffers, then exit"))) - -(define-key menu-bar-file-menu [separator-exit] - menu-bar-separator) - -;; Don't use delete-frame as event name because that is a special -;; event. -(define-key menu-bar-file-menu [delete-this-frame] - `(menu-item ,(purecopy "Delete Frame") delete-frame - :visible (fboundp 'delete-frame) - :enable (delete-frame-enabled-p) - :help ,(purecopy "Delete currently selected frame"))) -(define-key menu-bar-file-menu [make-frame-on-display] - `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display - :visible (fboundp 'make-frame-on-display) - :help ,(purecopy "Open a new frame on another display"))) -(define-key menu-bar-file-menu [make-frame] - `(menu-item ,(purecopy "New Frame") make-frame-command - :visible (fboundp 'make-frame-command) - :help ,(purecopy "Open a new frame"))) - -(define-key menu-bar-file-menu [one-window] - `(menu-item ,(purecopy "Remove Splits") delete-other-windows - :enable (not (one-window-p t nil)) - :help ,(purecopy "Selected window grows to fill the whole frame"))) - -(define-key menu-bar-file-menu [split-window] - `(menu-item ,(purecopy "Split Window") split-window-vertically - :enable (and (menu-bar-menu-frame-live-and-visible-p) - (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Split selected window in two windows"))) - -(define-key menu-bar-file-menu [separator-window] - menu-bar-separator) - -(define-key menu-bar-file-menu [ps-print-region] - `(menu-item ,(purecopy "Postscript Print Region (B+W)") ps-print-region - :enable mark-active - :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer"))) -(define-key menu-bar-file-menu [ps-print-buffer] - `(menu-item ,(purecopy "Postscript Print Buffer (B+W)") ps-print-buffer - :enable (menu-bar-menu-frame-live-and-visible-p) - :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer"))) -(define-key menu-bar-file-menu [ps-print-region-faces] - `(menu-item ,(purecopy "Postscript Print Region") ps-print-region-with-faces - :enable mark-active - :help ,(purecopy "Pretty-print marked region to PostScript printer"))) -(define-key menu-bar-file-menu [ps-print-buffer-faces] - `(menu-item ,(purecopy "Postscript Print Buffer") ps-print-buffer-with-faces - :enable (menu-bar-menu-frame-live-and-visible-p) - :help ,(purecopy "Pretty-print current buffer to PostScript printer"))) -(define-key menu-bar-file-menu [print-region] - `(menu-item ,(purecopy "Print Region") print-region - :enable mark-active - :help ,(purecopy "Print region between mark and current position"))) -(define-key menu-bar-file-menu [print-buffer] - `(menu-item ,(purecopy "Print Buffer") print-buffer - :enable (menu-bar-menu-frame-live-and-visible-p) - :help ,(purecopy "Print current buffer with page headings"))) - -(define-key menu-bar-file-menu [separator-print] - menu-bar-separator) - -(define-key menu-bar-file-menu [recover-session] - `(menu-item ,(purecopy "Recover Crashed Session") recover-session - :enable (and auto-save-list-file-prefix - (file-directory-p - (file-name-directory auto-save-list-file-prefix)) - (directory-files - (file-name-directory auto-save-list-file-prefix) - nil - (concat "\\`" - (regexp-quote - (file-name-nondirectory - auto-save-list-file-prefix))) - t)) - :help ,(purecopy "Recover edits from a crashed session"))) -(define-key menu-bar-file-menu [revert-buffer] - `(menu-item ,(purecopy "Revert Buffer") revert-buffer - :enable (or revert-buffer-function - revert-buffer-insert-file-contents-function - (and buffer-file-number - (or (buffer-modified-p) - (not (verify-visited-file-modtime - (current-buffer)))))) - :help ,(purecopy "Re-read current buffer from its file"))) -(define-key menu-bar-file-menu [write-file] - `(menu-item ,(purecopy "Save As...") write-file - :enable (and (menu-bar-menu-frame-live-and-visible-p) - (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Write current buffer to another file"))) -(define-key menu-bar-file-menu [save-buffer] - `(menu-item ,(purecopy "Save") save-buffer - :enable (and (buffer-modified-p) - (buffer-file-name) - (menu-bar-non-minibuffer-window-p)) - :help ,(purecopy "Save current buffer to its file"))) - -(define-key menu-bar-file-menu [separator-save] - menu-bar-separator) + (define-key menu [separator-exit] + menu-bar-separator) + + ;; Don't use delete-frame as event name because that is a special + ;; event. + (define-key menu [delete-this-frame] + `(menu-item ,(purecopy "Delete Frame") delete-frame + :visible (fboundp 'delete-frame) + :enable (delete-frame-enabled-p) + :help ,(purecopy "Delete currently selected frame"))) + (define-key menu [make-frame-on-display] + `(menu-item ,(purecopy "New Frame on Display...") make-frame-on-display + :visible (fboundp 'make-frame-on-display) + :help ,(purecopy "Open a new frame on another display"))) + (define-key menu [make-frame] + `(menu-item ,(purecopy "New Frame") make-frame-command + :visible (fboundp 'make-frame-command) + :help ,(purecopy "Open a new frame"))) + + (define-key menu [one-window] + `(menu-item ,(purecopy "Remove Splits") delete-other-windows + :enable (not (one-window-p t nil)) + :help ,(purecopy + "Selected window grows to fill the whole frame"))) + + (define-key menu [split-window] + `(menu-item ,(purecopy "Split Window") split-window-vertically + :enable (and (menu-bar-menu-frame-live-and-visible-p) + (menu-bar-non-minibuffer-window-p)) + :help ,(purecopy "Split selected window in two windows"))) + + (define-key menu [separator-window] + menu-bar-separator) + + (define-key menu [ps-print-region] + `(menu-item ,(purecopy "Postscript Print Region (B+W)") ps-print-region + :enable mark-active + :help ,(purecopy "Pretty-print marked region in black and white to PostScript printer"))) + (define-key menu [ps-print-buffer] + `(menu-item ,(purecopy "Postscript Print Buffer (B+W)") ps-print-buffer + :enable (menu-bar-menu-frame-live-and-visible-p) + :help ,(purecopy "Pretty-print current buffer in black and white to PostScript printer"))) + (define-key menu [ps-print-region-faces] + `(menu-item ,(purecopy "Postscript Print Region") + ps-print-region-with-faces + :enable mark-active + :help ,(purecopy + "Pretty-print marked region to PostScript printer"))) + (define-key menu [ps-print-buffer-faces] + `(menu-item ,(purecopy "Postscript Print Buffer") + ps-print-buffer-with-faces + :enable (menu-bar-menu-frame-live-and-visible-p) + :help ,(purecopy "Pretty-print current buffer to PostScript printer"))) + (define-key menu [print-region] + `(menu-item ,(purecopy "Print Region") print-region + :enable mark-active + :help ,(purecopy "Print region between mark and current position"))) + (define-key menu [print-buffer] + `(menu-item ,(purecopy "Print Buffer") print-buffer + :enable (menu-bar-menu-frame-live-and-visible-p) + :help ,(purecopy "Print current buffer with page headings"))) + + (define-key menu [separator-print] + menu-bar-separator) + + (define-key menu [recover-session] + `(menu-item ,(purecopy "Recover Crashed Session") recover-session + :enable + (and auto-save-list-file-prefix + (file-directory-p + (file-name-directory auto-save-list-file-prefix)) + (directory-files + (file-name-directory auto-save-list-file-prefix) + nil + (concat "\\`" + (regexp-quote + (file-name-nondirectory + auto-save-list-file-prefix))) + t)) + :help ,(purecopy "Recover edits from a crashed session"))) + (define-key menu [revert-buffer] + `(menu-item ,(purecopy "Revert Buffer") revert-buffer + :enable (or revert-buffer-function + revert-buffer-insert-file-contents-function + (and buffer-file-number + (or (buffer-modified-p) + (not (verify-visited-file-modtime + (current-buffer)))))) + :help ,(purecopy "Re-read current buffer from its file"))) + (define-key menu [write-file] + `(menu-item ,(purecopy "Save As...") write-file + :enable (and (menu-bar-menu-frame-live-and-visible-p) + (menu-bar-non-minibuffer-window-p)) + :help ,(purecopy "Write current buffer to another file"))) + (define-key menu [save-buffer] + `(menu-item ,(purecopy "Save") save-buffer + :enable (and (buffer-modified-p) + (buffer-file-name) + (menu-bar-non-minibuffer-window-p)) + :help ,(purecopy "Save current buffer to its file"))) + + (define-key menu [separator-save] + menu-bar-separator) + + + (define-key menu [kill-buffer] + `(menu-item ,(purecopy "Close") kill-this-buffer + :enable (kill-this-buffer-enabled-p) + :help ,(purecopy "Discard (kill) current buffer"))) + (define-key menu [insert-file] + `(menu-item ,(purecopy "Insert File...") insert-file + :enable (menu-bar-non-minibuffer-window-p) + :help ,(purecopy "Insert another file into current buffer"))) + (define-key menu [dired] + `(menu-item ,(purecopy "Open Directory...") dired + :enable (menu-bar-non-minibuffer-window-p) + :help ,(purecopy + "Read a directory, to operate on its files"))) + (define-key menu [open-file] + `(menu-item ,(purecopy "Open File...") menu-find-file-existing + :enable (menu-bar-non-minibuffer-window-p) + :help ,(purecopy + "Read an existing file into an Emacs buffer"))) + (define-key menu [new-file] + `(menu-item ,(purecopy "Visit New File...") find-file + :enable (menu-bar-non-minibuffer-window-p) + :help ,(purecopy + "Specify a new file's name, to edit the file"))) + + menu)) (defun menu-find-file-existing () "Edit the existing file FILENAME." @@ -206,31 +214,6 @@ (find-file-existing filename) (find-file filename)))) - -(define-key menu-bar-file-menu [kill-buffer] - `(menu-item ,(purecopy "Close") kill-this-buffer - :enable (kill-this-buffer-enabled-p) - :help ,(purecopy "Discard (kill) current buffer"))) -(define-key menu-bar-file-menu [insert-file] - `(menu-item ,(purecopy "Insert File...") insert-file - :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy "Insert another file into current buffer"))) -(define-key menu-bar-file-menu [dired] - `(menu-item ,(purecopy "Open Directory...") dired - :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy "Read a directory, to operate on its files"))) -(define-key menu-bar-file-menu [open-file] - `(menu-item ,(purecopy "Open File...") menu-find-file-existing - :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy "Read an existing file into an Emacs buffer"))) -(define-key menu-bar-file-menu [new-file] - `(menu-item ,(purecopy "Visit New File...") find-file - :enable (menu-bar-non-minibuffer-window-p) - :help ,(purecopy "Specify a new file's name, to edit the file"))) - - -;; The "Edit" menu items - ;; The "Edit->Search" submenu (defvar menu-bar-last-search-type nil "Type of last non-incremental search command called from the menu.") @@ -297,131 +280,253 @@ (isearch-update-ring string t) (re-search-backward string))) -(defvar menu-bar-search-menu (make-sparse-keymap "Search")) - ;; The Edit->Search->Incremental Search menu (defvar menu-bar-i-search-menu - (make-sparse-keymap "Incremental Search")) - -(define-key menu-bar-i-search-menu [isearch-backward-regexp] - `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp - :help ,(purecopy "Search backwards for a regular expression as you type it"))) -(define-key menu-bar-i-search-menu [isearch-forward-regexp] - `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp - :help ,(purecopy "Search forward for a regular expression as you type it"))) -(define-key menu-bar-i-search-menu [isearch-backward] - `(menu-item ,(purecopy "Backward String...") isearch-backward - :help ,(purecopy "Search backwards for a string as you type it"))) -(define-key menu-bar-i-search-menu [isearch-forward] - `(menu-item ,(purecopy "Forward String...") isearch-forward - :help ,(purecopy "Search forward for a string as you type it"))) - -(define-key menu-bar-search-menu [i-search] - `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu)) -(define-key menu-bar-search-menu [separator-tag-isearch] - menu-bar-separator) - -(define-key menu-bar-search-menu [tags-continue] - `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue - :help ,(purecopy "Continue last tags search operation"))) -(define-key menu-bar-search-menu [tags-srch] - `(menu-item ,(purecopy "Search Tagged Files...") tags-search - :help ,(purecopy "Search for a regexp in all tagged files"))) -(define-key menu-bar-search-menu [separator-tag-search] - menu-bar-separator) - -(define-key menu-bar-search-menu [repeat-search-back] - `(menu-item ,(purecopy "Repeat Backwards") nonincremental-repeat-search-backward - :enable (or (and (eq menu-bar-last-search-type 'string) - search-ring) - (and (eq menu-bar-last-search-type 'regexp) - regexp-search-ring)) - :help ,(purecopy "Repeat last search backwards"))) -(define-key menu-bar-search-menu [repeat-search-fwd] - `(menu-item ,(purecopy "Repeat Forward") nonincremental-repeat-search-forward - :enable (or (and (eq menu-bar-last-search-type 'string) - search-ring) - (and (eq menu-bar-last-search-type 'regexp) - regexp-search-ring)) - :help ,(purecopy "Repeat last search forward"))) -(define-key menu-bar-search-menu [separator-repeat-search] - menu-bar-separator) - -(define-key menu-bar-search-menu [re-search-backward] - `(menu-item ,(purecopy "Regexp Backwards...") nonincremental-re-search-backward - :help ,(purecopy "Search backwards for a regular expression"))) -(define-key menu-bar-search-menu [re-search-forward] - `(menu-item ,(purecopy "Regexp Forward...") nonincremental-re-search-forward - :help ,(purecopy "Search forward for a regular expression"))) - -(define-key menu-bar-search-menu [search-backward] - `(menu-item ,(purecopy "String Backwards...") nonincremental-search-backward - :help ,(purecopy "Search backwards for a string"))) -(define-key menu-bar-search-menu [search-forward] - `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward - :help ,(purecopy "Search forward for a string"))) + (let ((menu (make-sparse-keymap "Incremental Search"))) + (define-key menu [isearch-backward-regexp] + `(menu-item ,(purecopy "Backward Regexp...") isearch-backward-regexp + :help ,(purecopy + "Search backwards for a regular expression as you type it"))) + (define-key menu [isearch-forward-regexp] + `(menu-item ,(purecopy "Forward Regexp...") isearch-forward-regexp + :help ,(purecopy + "Search forward for a regular expression as you type it"))) + (define-key menu [isearch-backward] + `(menu-item ,(purecopy "Backward String...") isearch-backward + :help ,(purecopy "Search backwards for a string as you type it"))) + (define-key menu [isearch-forward] + `(menu-item ,(purecopy "Forward String...") isearch-forward + :help ,(purecopy "Search forward for a string as you type it"))) + menu)) + +(defvar menu-bar-search-menu + (let ((menu (make-sparse-keymap "Search"))) + + (define-key menu [i-search] + `(menu-item ,(purecopy "Incremental Search") ,menu-bar-i-search-menu)) + (define-key menu [separator-tag-isearch] + menu-bar-separator) + + (define-key menu [tags-continue] + `(menu-item ,(purecopy "Continue Tags Search") tags-loop-continue + :help ,(purecopy "Continue last tags search operation"))) + (define-key menu [tags-srch] + `(menu-item ,(purecopy "Search Tagged Files...") tags-search + :help ,(purecopy "Search for a regexp in all tagged files"))) + (define-key menu [separator-tag-search] menu-bar-separator) + + (define-key menu [repeat-search-back] + `(menu-item ,(purecopy "Repeat Backwards") + nonincremental-repeat-search-backward + :enable (or (and (eq menu-bar-last-search-type 'string) + search-ring) + (and (eq menu-bar-last-search-type 'regexp) + regexp-search-ring)) + :help ,(purecopy "Repeat last search backwards"))) + (define-key menu [repeat-search-fwd] + `(menu-item ,(purecopy "Repeat Forward") + nonincremental-repeat-search-forward + :enable (or (and (eq menu-bar-last-search-type 'string) + search-ring) + (and (eq menu-bar-last-search-type 'regexp) + regexp-search-ring)) + :help ,(purecopy "Repeat last search forward"))) + (define-key menu [separator-repeat-search] + menu-bar-separator) + + (define-key menu [re-search-backward] + `(menu-item ,(purecopy "Regexp Backwards...") + nonincremental-re-search-backward + :help ,(purecopy + "Search backwards for a regular expression"))) + (define-key menu [re-search-forward] + `(menu-item ,(purecopy "Regexp Forward...") + nonincremental-re-search-forward + :help ,(purecopy "Search forward for a regular expression"))) + + (define-key menu [search-backward] + `(menu-item ,(purecopy "String Backwards...") + nonincremental-search-backward + :help ,(purecopy "Search backwards for a string"))) + (define-key menu [search-forward] + `(menu-item ,(purecopy "String Forward...") nonincremental-search-forward + :help ,(purecopy "Search forward for a string"))) + menu)) ;; The Edit->Replace submenu -(defvar menu-bar-replace-menu (make-sparse-keymap "Replace")) - -(define-key menu-bar-replace-menu [tags-repl-continue] - `(menu-item ,(purecopy "Continue Replace") tags-loop-continue - :help ,(purecopy "Continue last tags replace operation"))) -(define-key menu-bar-replace-menu [tags-repl] - `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace - :help ,(purecopy "Interactively replace a regexp in all tagged files"))) -(define-key menu-bar-replace-menu [separator-replace-tags] - menu-bar-separator) - -(define-key menu-bar-replace-menu [query-replace-regexp] - `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp - :enable (not buffer-read-only) - :help ,(purecopy "Replace regular expression interactively, ask about each occurrence"))) -(define-key menu-bar-replace-menu [query-replace] - `(menu-item ,(purecopy "Replace String...") query-replace - :enable (not buffer-read-only) - :help ,(purecopy "Replace string interactively, ask about each occurrence"))) +(defvar menu-bar-replace-menu + (let ((menu (make-sparse-keymap "Replace"))) + (define-key menu [tags-repl-continue] + `(menu-item ,(purecopy "Continue Replace") tags-loop-continue + :help ,(purecopy "Continue last tags replace operation"))) + (define-key menu [tags-repl] + `(menu-item ,(purecopy "Replace in Tagged Files...") tags-query-replace + :help ,(purecopy + "Interactively replace a regexp in all tagged files"))) + (define-key menu [separator-replace-tags] + menu-bar-separator) + + (define-key menu [query-replace-regexp] + `(menu-item ,(purecopy "Replace Regexp...") query-replace-regexp + :enable (not buffer-read-only) + :help ,(purecopy "Replace regular expression interactively, ask about each occurrence"))) + (define-key menu [query-replace] + `(menu-item ,(purecopy "Replace String...") query-replace + :enable (not buffer-read-only) + :help ,(purecopy + "Replace string interactively, ask about each occurrence"))) + menu)) ;;; Assemble the top-level Edit menu items. -(define-key menu-bar-edit-menu [props] - `(menu-item ,(purecopy "Text Properties") facemenu-menu)) - -;; ns-win.el said: Add spell for platorm consistency. -(if (featurep 'ns) - (define-key menu-bar-edit-menu [spell] - `(menu-item ,(purecopy "Spell") ispell-menu-map))) - -(define-key menu-bar-edit-menu [fill] - `(menu-item ,(purecopy "Fill") fill-region - :enable (and mark-active (not buffer-read-only)) - :help - ,(purecopy "Fill text in region to fit between left and right margin"))) - -(define-key menu-bar-edit-menu [separator-bookmark] - menu-bar-separator) - -(define-key menu-bar-edit-menu [bookmark] - `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map)) +(defvar menu-bar-goto-menu + (let ((menu (make-sparse-keymap "Go To"))) + + (define-key menu [set-tags-name] + `(menu-item ,(purecopy "Set Tags File Name...") visit-tags-table + :help ,(purecopy "Tell Tags commands which tag table file to use"))) + + (define-key menu [separator-tag-file] + menu-bar-separator) + + (define-key menu [apropos-tags] + `(menu-item ,(purecopy "Tags Apropos...") tags-apropos + :help ,(purecopy "Find function/variables whose names match regexp"))) + (define-key menu [next-tag-otherw] + `(menu-item ,(purecopy "Next Tag in Other Window") + menu-bar-next-tag-other-window + :enable (and (boundp 'tags-location-ring) + (not (ring-empty-p tags-location-ring))) + :help ,(purecopy "Find next function/variable matching last tag name in another window"))) + + (define-key menu [next-tag] + `(menu-item ,(purecopy "Find Next Tag") + menu-bar-next-tag + :enable (and (boundp 'tags-location-ring) + (not (ring-empty-p tags-location-ring))) + :help ,(purecopy "Find next function/variable matching last tag name"))) + (define-key menu [find-tag-otherw] + `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window + :help ,(purecopy "Find function/variable definition in another window"))) + (define-key menu [find-tag] + `(menu-item ,(purecopy "Find Tag...") find-tag + :help ,(purecopy "Find definition of function or variable"))) + + (define-key menu [separator-tags] + menu-bar-separator) + + (define-key menu [end-of-buf] + `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer)) + (define-key menu [beg-of-buf] + `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer)) + (define-key menu [go-to-pos] + `(menu-item ,(purecopy "Goto Buffer Position...") goto-char + :help ,(purecopy "Read a number N and go to buffer position N"))) + (define-key menu [go-to-line] + `(menu-item ,(purecopy "Goto Line...") goto-line + :help ,(purecopy "Read a line number and go to that line"))) + menu)) -(defvar menu-bar-goto-menu (make-sparse-keymap "Go To")) -(define-key menu-bar-goto-menu [set-tags-name] - `(menu-item ,(purecopy "Set Tags File Name...") visit-tags-table - :help ,(purecopy "Tell Tags commands which tag table file to use"))) - -(define-key menu-bar-goto-menu [separator-tag-file] - menu-bar-separator) +(defvar yank-menu (cons (purecopy "Select Yank") nil)) +(fset 'yank-menu (cons 'keymap yank-menu)) -(define-key menu-bar-goto-menu [apropos-tags] - `(menu-item ,(purecopy "Tags Apropos...") tags-apropos - :help ,(purecopy "Find function/variables whose names match regexp"))) -(define-key menu-bar-goto-menu [next-tag-otherw] - `(menu-item ,(purecopy "Next Tag in Other Window") - menu-bar-next-tag-other-window - :enable (and (boundp 'tags-location-ring) - (not (ring-empty-p tags-location-ring))) - :help ,(purecopy "Find next function/variable matching last tag name in another window"))) +(defvar menu-bar-edit-menu + (let ((menu (make-sparse-keymap "Edit"))) + + (define-key menu [props] + `(menu-item ,(purecopy "Text Properties") facemenu-menu)) + + ;; ns-win.el said: Add spell for platorm consistency. + (if (featurep 'ns) + (define-key menu [spell] + `(menu-item ,(purecopy "Spell") ispell-menu-map))) + + (define-key menu [fill] + `(menu-item ,(purecopy "Fill") fill-region + :enable (and mark-active (not buffer-read-only)) + :help + ,(purecopy "Fill text in region to fit between left and right margin"))) + + (define-key menu [separator-bookmark] + menu-bar-separator) + + (define-key menu [bookmark] + `(menu-item ,(purecopy "Bookmarks") menu-bar-bookmark-map)) + + (define-key menu [goto] + `(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu)) + + (define-key menu [replace] + `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu)) + + (define-key menu [search] + `(menu-item ,(purecopy "Search") ,menu-bar-search-menu)) + + (define-key menu [separator-search] + menu-bar-separator) + + (define-key menu [mark-whole-buffer] + `(menu-item ,(purecopy "Select All") mark-whole-buffer + :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy"))) + (define-key menu [clear] + `(menu-item ,(purecopy "Clear") delete-region + :enable (and mark-active + (not buffer-read-only)) + :help + ,(purecopy "Delete the text in region between mark and current position"))) + + + (define-key menu (if (featurep 'ns) [select-paste] + [paste-from-menu]) + ;; ns-win.el said: Change text to be more consistent with + ;; surrounding menu items `paste', etc." + `(menu-item ,(purecopy (if (featurep 'ns) "Select and Paste" + "Paste from Kill Menu")) yank-menu + :enable (and (cdr yank-menu) (not buffer-read-only)) + :help ,(purecopy "Choose a string from the kill ring and paste it"))) + (define-key menu [paste] + `(menu-item ,(purecopy "Paste") yank + :enable (and (or + ;; Emacs compiled --without-x (or --with-ns) + ;; doesn't have x-selection-exists-p. + (and (fboundp 'x-selection-exists-p) + (x-selection-exists-p 'CLIPBOARD)) + (if (featurep 'ns) ; like paste-from-menu + (cdr yank-menu) + kill-ring)) + (not buffer-read-only)) + :help ,(purecopy "Paste (yank) text most recently cut/copied"))) + (define-key menu [copy] + ;; ns-win.el said: Substitute a Copy function that works better + ;; under X (for GNUstep). + `(menu-item ,(purecopy "Copy") ,(if (featurep 'ns) + 'ns-copy-including-secondary + 'kill-ring-save) + :enable mark-active + :help ,(purecopy "Copy text in region between mark and current position") + :keys ,(purecopy (if (featurep 'ns) + "\\[ns-copy-including-secondary]" + "\\[kill-ring-save]")))) + (define-key menu [cut] + `(menu-item ,(purecopy "Cut") kill-region + :enable (and mark-active (not buffer-read-only)) + :help + ,(purecopy "Cut (kill) text in region between mark and current position"))) + ;; ns-win.el said: Separate undo from cut/paste section. + (if (featurep 'ns) + (define-key menu [separator-undo] menu-bar-separator)) + + (define-key menu [undo] + `(menu-item ,(purecopy "Undo") undo + :enable (and (not buffer-read-only) + (not (eq t buffer-undo-list)) + (if (eq last-command 'undo) + (listp pending-undo-list) + (consp buffer-undo-list))) + :help ,(purecopy "Undo last operation"))) + + menu)) (defun menu-bar-next-tag-other-window () "Find the next definition of the tag already specified." @@ -433,105 +538,6 @@ (interactive) (find-tag nil t)) -(define-key menu-bar-goto-menu [next-tag] - `(menu-item ,(purecopy "Find Next Tag") - menu-bar-next-tag - :enable (and (boundp 'tags-location-ring) - (not (ring-empty-p tags-location-ring))) - :help ,(purecopy "Find next function/variable matching last tag name"))) -(define-key menu-bar-goto-menu [find-tag-otherw] - `(menu-item ,(purecopy "Find Tag in Other Window...") find-tag-other-window - :help ,(purecopy "Find function/variable definition in another window"))) -(define-key menu-bar-goto-menu [find-tag] - `(menu-item ,(purecopy "Find Tag...") find-tag - :help ,(purecopy "Find definition of function or variable"))) - -(define-key menu-bar-goto-menu [separator-tags] - menu-bar-separator) - -(define-key menu-bar-goto-menu [end-of-buf] - `(menu-item ,(purecopy "Goto End of Buffer") end-of-buffer)) -(define-key menu-bar-goto-menu [beg-of-buf] - `(menu-item ,(purecopy "Goto Beginning of Buffer") beginning-of-buffer)) -(define-key menu-bar-goto-menu [go-to-pos] - `(menu-item ,(purecopy "Goto Buffer Position...") goto-char - :help ,(purecopy "Read a number N and go to buffer position N"))) -(define-key menu-bar-goto-menu [go-to-line] - `(menu-item ,(purecopy "Goto Line...") goto-line - :help ,(purecopy "Read a line number and go to that line"))) - -(define-key menu-bar-edit-menu [goto] - `(menu-item ,(purecopy "Go To") ,menu-bar-goto-menu)) - -(define-key menu-bar-edit-menu [replace] - `(menu-item ,(purecopy "Replace") ,menu-bar-replace-menu)) - -(define-key menu-bar-edit-menu [search] - `(menu-item ,(purecopy "Search") ,menu-bar-search-menu)) - -(define-key menu-bar-edit-menu [separator-search] - menu-bar-separator) - -(define-key menu-bar-edit-menu [mark-whole-buffer] - `(menu-item ,(purecopy "Select All") mark-whole-buffer - :help ,(purecopy "Mark the whole buffer for a subsequent cut/copy"))) -(define-key menu-bar-edit-menu [clear] - `(menu-item ,(purecopy "Clear") delete-region - :enable (and mark-active - (not buffer-read-only)) - :help - ,(purecopy "Delete the text in region between mark and current position"))) -(defvar yank-menu (cons (purecopy "Select Yank") nil)) -(fset 'yank-menu (cons 'keymap yank-menu)) -(define-key menu-bar-edit-menu (if (featurep 'ns) [select-paste] - [paste-from-menu]) - ;; ns-win.el said: Change text to be more consistent with - ;; surrounding menu items `paste', etc." - `(menu-item ,(purecopy (if (featurep 'ns) "Select and Paste" - "Paste from Kill Menu")) yank-menu - :enable (and (cdr yank-menu) (not buffer-read-only)) - :help ,(purecopy "Choose a string from the kill ring and paste it"))) -(define-key menu-bar-edit-menu [paste] - `(menu-item ,(purecopy "Paste") yank - :enable (and (or - ;; Emacs compiled --without-x (or --with-ns) - ;; doesn't have x-selection-exists-p. - (and (fboundp 'x-selection-exists-p) - (x-selection-exists-p 'CLIPBOARD)) - (if (featurep 'ns) ; like paste-from-menu - (cdr yank-menu) - kill-ring)) - (not buffer-read-only)) - :help ,(purecopy "Paste (yank) text most recently cut/copied"))) -(define-key menu-bar-edit-menu [copy] - ;; ns-win.el said: Substitute a Copy function that works better - ;; under X (for GNUstep). - `(menu-item ,(purecopy "Copy") ,(if (featurep 'ns) - 'ns-copy-including-secondary - 'kill-ring-save) - :enable mark-active - :help ,(purecopy "Copy text in region between mark and current position") - :keys ,(purecopy (if (featurep 'ns) - "\\[ns-copy-including-secondary]" - "\\[kill-ring-save]")))) -(define-key menu-bar-edit-menu [cut] - `(menu-item ,(purecopy "Cut") kill-region - :enable (and mark-active (not buffer-read-only)) - :help - ,(purecopy "Cut (kill) text in region between mark and current position"))) -;; ns-win.el said: Separate undo from cut/paste section. -(if (featurep 'ns) - (define-key menu-bar-edit-menu [separator-undo] menu-bar-separator)) - -(define-key menu-bar-edit-menu [undo] - `(menu-item ,(purecopy "Undo") undo - :enable (and (not buffer-read-only) - (not (eq t buffer-undo-list)) - (if (eq last-command 'undo) - (listp pending-undo-list) - (consp buffer-undo-list))) - :help ,(purecopy "Undo last operation"))) - (define-obsolete-function-alias 'menu-bar-kill-ring-save 'kill-ring-save "24.1") @@ -581,48 +587,49 @@ Do the same for the keys of the same name." ;; The "Options" menu items -(defvar menu-bar-custom-menu (make-sparse-keymap "Customize")) - -(define-key menu-bar-custom-menu [customize-apropos-faces] - `(menu-item ,(purecopy "Faces Matching...") customize-apropos-faces - :help ,(purecopy "Browse faces matching a regexp or word list"))) -(define-key menu-bar-custom-menu [customize-apropos-options] - `(menu-item ,(purecopy "Options Matching...") customize-apropos-options - :help ,(purecopy "Browse options matching a regexp or word list"))) -(define-key menu-bar-custom-menu [customize-apropos] - `(menu-item ,(purecopy "All Settings Matching...") customize-apropos - :help ,(purecopy "Browse customizable settings matching a regexp or word list"))) -(define-key menu-bar-custom-menu [separator-1] - menu-bar-separator) -(define-key menu-bar-custom-menu [customize-group] - `(menu-item ,(purecopy "Specific Group...") customize-group - :help ,(purecopy "Customize settings of specific group"))) -(define-key menu-bar-custom-menu [customize-face] - `(menu-item ,(purecopy "Specific Face...") customize-face - :help ,(purecopy "Customize attributes of specific face"))) -(define-key menu-bar-custom-menu [customize-option] - `(menu-item ,(purecopy "Specific Option...") customize-option - :help ,(purecopy "Customize value of specific option"))) -(define-key menu-bar-custom-menu [separator-2] - menu-bar-separator) -(define-key menu-bar-custom-menu [customize-changed-options] - `(menu-item ,(purecopy "New Options...") customize-changed-options - :help ,(purecopy "Options added or changed in recent Emacs versions"))) -(define-key menu-bar-custom-menu [customize-saved] - `(menu-item ,(purecopy "Saved Options") customize-saved - :help ,(purecopy "Customize previously saved options"))) -(define-key menu-bar-custom-menu [separator-3] - menu-bar-separator) -(define-key menu-bar-custom-menu [customize-browse] - `(menu-item ,(purecopy "Browse Customization Groups") customize-browse - :help ,(purecopy "Browse all customization groups"))) -(define-key menu-bar-custom-menu [customize] - `(menu-item ,(purecopy "Top-level Customization Group") customize - :help ,(purecopy "The master group called `Emacs'"))) -(define-key menu-bar-custom-menu [customize-themes] - `(menu-item ,(purecopy "Custom Themes") customize-themes - :help ,(purecopy "Choose a pre-defined customization theme"))) - +(defvar menu-bar-custom-menu + (let ((menu (make-sparse-keymap "Customize"))) + + (define-key menu [customize-apropos-faces] + `(menu-item ,(purecopy "Faces Matching...") customize-apropos-faces + :help ,(purecopy "Browse faces matching a regexp or word list"))) + (define-key menu [customize-apropos-options] + `(menu-item ,(purecopy "Options Matching...") customize-apropos-options + :help ,(purecopy "Browse options matching a regexp or word list"))) + (define-key menu [customize-apropos] + `(menu-item ,(purecopy "All Settings Matching...") customize-apropos + :help ,(purecopy "Browse customizable settings matching a regexp or word list"))) + (define-key menu [separator-1] + menu-bar-separator) + (define-key menu [customize-group] + `(menu-item ,(purecopy "Specific Group...") customize-group + :help ,(purecopy "Customize settings of specific group"))) + (define-key menu [customize-face] + `(menu-item ,(purecopy "Specific Face...") customize-face + :help ,(purecopy "Customize attributes of specific face"))) + (define-key menu [customize-option] + `(menu-item ,(purecopy "Specific Option...") customize-option + :help ,(purecopy "Customize value of specific option"))) + (define-key menu [separator-2] + menu-bar-separator) + (define-key menu [customize-changed-options] + `(menu-item ,(purecopy "New Options...") customize-changed-options + :help ,(purecopy "Options added or changed in recent Emacs versions"))) + (define-key menu [customize-saved] + `(menu-item ,(purecopy "Saved Options") customize-saved + :help ,(purecopy "Customize previously saved options"))) + (define-key menu [separator-3] + menu-bar-separator) + (define-key menu [customize-browse] + `(menu-item ,(purecopy "Browse Customization Groups") customize-browse + :help ,(purecopy "Browse all customization groups"))) + (define-key menu [customize] + `(menu-item ,(purecopy "Top-level Customization Group") customize + :help ,(purecopy "The master group called `Emacs'"))) + (define-key menu [customize-themes] + `(menu-item ,(purecopy "Custom Themes") customize-themes + :help ,(purecopy "Choose a pre-defined customization theme"))) + menu)) ;(defvar menu-bar-preferences-menu (make-sparse-keymap "Preferences")) (defmacro menu-bar-make-mm-toggle (fname doc help &optional props) @@ -692,12 +699,6 @@ by \"Save Options\" in Custom buffers.") (custom-push-theme 'theme-face 'default 'user 'set spec) (put 'default 'face-modified nil)))) - - -;;; Assemble all the top-level items of the "Options" menu -(define-key menu-bar-options-menu [customize] - `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu)) - (defun menu-bar-options-save () "Save current values of Options menu items using Custom." (interactive) @@ -745,276 +746,204 @@ by \"Save Options\" in Custom buffers.") (when need-save (custom-save-all)))) -(define-key menu-bar-options-menu [package] - '(menu-item "Manage Emacs Packages" package-list-packages - :help "Install or uninstall additional Emacs packages")) - -(define-key menu-bar-options-menu [save] - `(menu-item ,(purecopy "Save Options") menu-bar-options-save - :help ,(purecopy "Save options set from the menu above"))) - -(define-key menu-bar-options-menu [custom-separator] - menu-bar-separator) - -(define-key menu-bar-options-menu [menu-set-font] - `(menu-item ,(purecopy "Set Default Font...") menu-set-font - :visible (display-multi-font-p) - :help ,(purecopy "Select a default font"))) - -(if (featurep 'system-font-setting) - (define-key menu-bar-options-menu [menu-system-font] - (menu-bar-make-toggle toggle-use-system-font font-use-system-font - "Use system font" - "Use system font: %s" - "Use the monospaced font defined by the system"))) +;;; Assemble all the top-level items of the "Options" menu ;; The "Show/Hide" submenu of menu "Options" -(defvar menu-bar-showhide-menu (make-sparse-keymap "Show/Hide")) - -(define-key menu-bar-showhide-menu [column-number-mode] - (menu-bar-make-mm-toggle column-number-mode - "Column Numbers" - "Show the current column number in the mode line")) - -(define-key menu-bar-showhide-menu [line-number-mode] - (menu-bar-make-mm-toggle line-number-mode - "Line Numbers" - "Show the current line number in the mode line")) - -(define-key menu-bar-showhide-menu [size-indication-mode] - (menu-bar-make-mm-toggle size-indication-mode - "Size Indication" - "Show the size of the buffer in the mode line")) - -(define-key menu-bar-showhide-menu [linecolumn-separator] - menu-bar-separator) - -(define-key menu-bar-showhide-menu [showhide-battery] - (menu-bar-make-mm-toggle display-battery-mode - "Battery Status" - "Display battery status information in mode line")) - -(define-key menu-bar-showhide-menu [showhide-date-time] - (menu-bar-make-mm-toggle display-time-mode - "Time, Load and Mail" - "Display time, system load averages and \ -mail status in mode line")) - -(define-key menu-bar-showhide-menu [datetime-separator] - menu-bar-separator) - -(define-key menu-bar-showhide-menu [showhide-speedbar] - `(menu-item ,(purecopy "Speedbar") speedbar-frame-mode - :help ,(purecopy "Display a Speedbar quick-navigation frame") - :button (:toggle - . (and (boundp 'speedbar-frame) - (frame-live-p (symbol-value 'speedbar-frame)) - (frame-visible-p - (symbol-value 'speedbar-frame)))))) - -(defvar menu-bar-showhide-fringe-menu (make-sparse-keymap "Fringe")) - -(defvar menu-bar-showhide-fringe-ind-menu - (make-sparse-keymap "Buffer boundaries")) - (defun menu-bar-showhide-fringe-ind-customize () "Show customization buffer for `indicate-buffer-boundaries'." (interactive) (customize-variable 'indicate-buffer-boundaries)) -(define-key menu-bar-showhide-fringe-ind-menu [customize] - `(menu-item ,(purecopy "Other (Customize)") - menu-bar-showhide-fringe-ind-customize - :help ,(purecopy "Additional choices available through Custom buffer") - :visible (display-graphic-p) - :button (:radio . (not (member indicate-buffer-boundaries - '(nil left right - ((top . left) (bottom . right)) - ((t . right) (top . left)))))))) - (defun menu-bar-showhide-fringe-ind-mixed () "Display top and bottom indicators in opposite fringes, arrows in right." (interactive) (customize-set-variable 'indicate-buffer-boundaries '((t . right) (top . left)))) -(define-key menu-bar-showhide-fringe-ind-menu [mixed] - `(menu-item ,(purecopy "Opposite, Arrows Right") menu-bar-showhide-fringe-ind-mixed - :help - ,(purecopy "Show top/bottom indicators in opposite fringes, arrows in right") - :visible (display-graphic-p) - :button (:radio . (equal indicate-buffer-boundaries - '((t . right) (top . left)))))) - (defun menu-bar-showhide-fringe-ind-box () "Display top and bottom indicators in opposite fringes." (interactive) (customize-set-variable 'indicate-buffer-boundaries '((top . left) (bottom . right)))) -(define-key menu-bar-showhide-fringe-ind-menu [box] - `(menu-item ,(purecopy "Opposite, No Arrows") menu-bar-showhide-fringe-ind-box - :help ,(purecopy "Show top/bottom indicators in opposite fringes, no arrows") - :visible (display-graphic-p) - :button (:radio . (equal indicate-buffer-boundaries - '((top . left) (bottom . right)))))) - (defun menu-bar-showhide-fringe-ind-right () "Display buffer boundaries and arrows in the right fringe." (interactive) (customize-set-variable 'indicate-buffer-boundaries 'right)) -(define-key menu-bar-showhide-fringe-ind-menu [right] - `(menu-item ,(purecopy "In Right Fringe") menu-bar-showhide-fringe-ind-right - :help ,(purecopy "Show buffer boundaries and arrows in right fringe") - :visible (display-graphic-p) - :button (:radio . (eq indicate-buffer-boundaries 'right)))) - (defun menu-bar-showhide-fringe-ind-left () "Display buffer boundaries and arrows in the left fringe." (interactive) (customize-set-variable 'indicate-buffer-boundaries 'left)) -(define-key menu-bar-showhide-fringe-ind-menu [left] - `(menu-item ,(purecopy "In Left Fringe") menu-bar-showhide-fringe-ind-left - :help ,(purecopy "Show buffer boundaries and arrows in left fringe") - :visible (display-graphic-p) - :button (:radio . (eq indicate-buffer-boundaries 'left)))) - (defun menu-bar-showhide-fringe-ind-none () "Do not display any buffer boundary indicators." (interactive) (customize-set-variable 'indicate-buffer-boundaries nil)) -(define-key menu-bar-showhide-fringe-ind-menu [none] - `(menu-item ,(purecopy "No Indicators") menu-bar-showhide-fringe-ind-none - :help ,(purecopy "Hide all buffer boundary indicators and arrows") - :visible (display-graphic-p) - :button (:radio . (eq indicate-buffer-boundaries nil)))) - -(define-key menu-bar-showhide-fringe-menu [showhide-fringe-ind] - `(menu-item ,(purecopy "Buffer Boundaries") ,menu-bar-showhide-fringe-ind-menu - :visible (display-graphic-p) - :help ,(purecopy "Indicate buffer boundaries in fringe"))) - -(define-key menu-bar-showhide-fringe-menu [indicate-empty-lines] - (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines - "Empty Line Indicators" - "Indicating of empty lines %s" - "Indicate trailing empty lines in fringe, globally")) +(defvar menu-bar-showhide-fringe-ind-menu + (let ((menu (make-sparse-keymap "Buffer boundaries"))) + + (define-key menu [customize] + `(menu-item ,(purecopy "Other (Customize)") + menu-bar-showhide-fringe-ind-customize + :help ,(purecopy "Additional choices available through Custom buffer") + :visible (display-graphic-p) + :button (:radio . (not (member indicate-buffer-boundaries + '(nil left right + ((top . left) (bottom . right)) + ((t . right) (top . left)))))))) + + (define-key menu [mixed] + `(menu-item ,(purecopy "Opposite, Arrows Right") menu-bar-showhide-fringe-ind-mixed + :help + ,(purecopy "Show top/bottom indicators in opposite fringes, arrows in right") + :visible (display-graphic-p) + :button (:radio . (equal indicate-buffer-boundaries + '((t . right) (top . left)))))) + + (define-key menu [box] + `(menu-item ,(purecopy "Opposite, No Arrows") menu-bar-showhide-fringe-ind-box + :help ,(purecopy "Show top/bottom indicators in opposite fringes, no arrows") + :visible (display-graphic-p) + :button (:radio . (equal indicate-buffer-boundaries + '((top . left) (bottom . right)))))) + + (define-key menu [right] + `(menu-item ,(purecopy "In Right Fringe") menu-bar-showhide-fringe-ind-right + :help ,(purecopy "Show buffer boundaries and arrows in right fringe") + :visible (display-graphic-p) + :button (:radio . (eq indicate-buffer-boundaries 'right)))) + + (define-key menu [left] + `(menu-item ,(purecopy "In Left Fringe") menu-bar-showhide-fringe-ind-left + :help ,(purecopy "Show buffer boundaries and arrows in left fringe") + :visible (display-graphic-p) + :button (:radio . (eq indicate-buffer-boundaries 'left)))) + + (define-key menu [none] + `(menu-item ,(purecopy "No Indicators") menu-bar-showhide-fringe-ind-none + :help ,(purecopy "Hide all buffer boundary indicators and arrows") + :visible (display-graphic-p) + :button (:radio . (eq indicate-buffer-boundaries nil)))) + menu)) (defun menu-bar-showhide-fringe-menu-customize () "Show customization buffer for `fringe-mode'." (interactive) (customize-variable 'fringe-mode)) -(define-key menu-bar-showhide-fringe-menu [customize] - `(menu-item ,(purecopy "Customize Fringe") menu-bar-showhide-fringe-menu-customize - :help ,(purecopy "Detailed customization of fringe") - :visible (display-graphic-p))) - (defun menu-bar-showhide-fringe-menu-customize-reset () "Reset the fringe mode: display fringes on both sides of a window." (interactive) (customize-set-variable 'fringe-mode nil)) -(define-key menu-bar-showhide-fringe-menu [default] - `(menu-item ,(purecopy "Default") menu-bar-showhide-fringe-menu-customize-reset - :help ,(purecopy "Default width fringe on both left and right side") - :visible (display-graphic-p) - :button (:radio . (eq fringe-mode nil)))) - (defun menu-bar-showhide-fringe-menu-customize-right () "Display fringes only on the right of each window." (interactive) (require 'fringe) (customize-set-variable 'fringe-mode '(0 . nil))) -(define-key menu-bar-showhide-fringe-menu [right] - `(menu-item ,(purecopy "On the Right") menu-bar-showhide-fringe-menu-customize-right - :help ,(purecopy "Fringe only on the right side") - :visible (display-graphic-p) - :button (:radio . (equal fringe-mode '(0 . nil))))) - (defun menu-bar-showhide-fringe-menu-customize-left () "Display fringes only on the left of each window." (interactive) (require 'fringe) (customize-set-variable 'fringe-mode '(nil . 0))) -(define-key menu-bar-showhide-fringe-menu [left] - `(menu-item ,(purecopy "On the Left") menu-bar-showhide-fringe-menu-customize-left - :help ,(purecopy "Fringe only on the left side") - :visible (display-graphic-p) - :button (:radio . (equal fringe-mode '(nil . 0))))) - (defun menu-bar-showhide-fringe-menu-customize-disable () "Do not display window fringes." (interactive) (require 'fringe) (customize-set-variable 'fringe-mode 0)) -(define-key menu-bar-showhide-fringe-menu [none] - `(menu-item ,(purecopy "None") menu-bar-showhide-fringe-menu-customize-disable - :help ,(purecopy "Turn off fringe") - :visible (display-graphic-p) - :button (:radio . (eq fringe-mode 0)))) - -(define-key menu-bar-showhide-menu [showhide-fringe] - `(menu-item ,(purecopy "Fringe") ,menu-bar-showhide-fringe-menu - :visible (display-graphic-p))) - -(defvar menu-bar-showhide-scroll-bar-menu (make-sparse-keymap "Scroll-bar")) - -(define-key menu-bar-showhide-scroll-bar-menu [right] - `(menu-item ,(purecopy "On the Right") - menu-bar-right-scroll-bar - :help ,(purecopy "Scroll-bar on the right side") - :visible (display-graphic-p) - :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) 'right)))) +(defvar menu-bar-showhide-fringe-menu + (let ((menu (make-sparse-keymap "Fringe"))) + + (define-key menu [showhide-fringe-ind] + `(menu-item ,(purecopy "Buffer Boundaries") ,menu-bar-showhide-fringe-ind-menu + :visible (display-graphic-p) + :help ,(purecopy "Indicate buffer boundaries in fringe"))) + + (define-key menu [indicate-empty-lines] + (menu-bar-make-toggle toggle-indicate-empty-lines indicate-empty-lines + "Empty Line Indicators" + "Indicating of empty lines %s" + "Indicate trailing empty lines in fringe, globally")) + + (define-key menu [customize] + `(menu-item ,(purecopy "Customize Fringe") menu-bar-showhide-fringe-menu-customize + :help ,(purecopy "Detailed customization of fringe") + :visible (display-graphic-p))) + + (define-key menu [default] + `(menu-item ,(purecopy "Default") menu-bar-showhide-fringe-menu-customize-reset + :help ,(purecopy "Default width fringe on both left and right side") + :visible (display-graphic-p) + :button (:radio . (eq fringe-mode nil)))) + + (define-key menu [right] + `(menu-item ,(purecopy "On the Right") menu-bar-showhide-fringe-menu-customize-right + :help ,(purecopy "Fringe only on the right side") + :visible (display-graphic-p) + :button (:radio . (equal fringe-mode '(0 . nil))))) + + (define-key menu [left] + `(menu-item ,(purecopy "On the Left") menu-bar-showhide-fringe-menu-customize-left + :help ,(purecopy "Fringe only on the left side") + :visible (display-graphic-p) + :button (:radio . (equal fringe-mode '(nil . 0))))) + + (define-key menu [none] + `(menu-item ,(purecopy "None") menu-bar-showhide-fringe-menu-customize-disable + :help ,(purecopy "Turn off fringe") + :visible (display-graphic-p) + :button (:radio . (eq fringe-mode 0)))) + menu)) + (defun menu-bar-right-scroll-bar () "Display scroll bars on the right of each window." (interactive) (customize-set-variable 'scroll-bar-mode 'right)) -(define-key menu-bar-showhide-scroll-bar-menu [left] - `(menu-item ,(purecopy "On the Left") - menu-bar-left-scroll-bar - :help ,(purecopy "Scroll-bar on the left side") - :visible (display-graphic-p) - :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) 'left)))) - (defun menu-bar-left-scroll-bar () "Display scroll bars on the left of each window." (interactive) (customize-set-variable 'scroll-bar-mode 'left)) -(define-key menu-bar-showhide-scroll-bar-menu [none] - `(menu-item ,(purecopy "None") - menu-bar-no-scroll-bar - :help ,(purecopy "Turn off scroll-bar") - :visible (display-graphic-p) - :button (:radio . (eq (cdr (assq 'vertical-scroll-bars - (frame-parameters))) nil)))) - (defun menu-bar-no-scroll-bar () "Turn off scroll bars." (interactive) (customize-set-variable 'scroll-bar-mode nil)) -(define-key menu-bar-showhide-menu [showhide-scroll-bar] - `(menu-item ,(purecopy "Scroll-bar") ,menu-bar-showhide-scroll-bar-menu - :visible (display-graphic-p))) - -(define-key menu-bar-showhide-menu [showhide-tooltip-mode] - `(menu-item ,(purecopy "Tooltips") tooltip-mode - :help ,(purecopy "Turn tooltips on/off") - :visible (and (display-graphic-p) (fboundp 'x-show-tip)) - :button (:toggle . tooltip-mode))) +(defvar menu-bar-showhide-scroll-bar-menu + (let ((menu (make-sparse-keymap "Scroll-bar"))) + + (define-key menu [right] + `(menu-item ,(purecopy "On the Right") + menu-bar-right-scroll-bar + :help ,(purecopy "Scroll-bar on the right side") + :visible (display-graphic-p) + :button (:radio . (eq (cdr (assq 'vertical-scroll-bars + (frame-parameters))) 'right)))) + + (define-key menu [left] + `(menu-item ,(purecopy "On the Left") + menu-bar-left-scroll-bar + :help ,(purecopy "Scroll-bar on the left side") + :visible (display-graphic-p) + :button (:radio . (eq (cdr (assq 'vertical-scroll-bars + (frame-parameters))) 'left)))) + + (define-key menu [none] + `(menu-item ,(purecopy "None") + menu-bar-no-scroll-bar + :help ,(purecopy "Turn off scroll-bar") + :visible (display-graphic-p) + :button (:radio . (eq (cdr (assq 'vertical-scroll-bars + (frame-parameters))) nil)))) + menu)) (defun menu-bar-frame-for-menubar () "Return the frame suitable for updating the menu bar." @@ -1027,14 +956,6 @@ mail status in mode line")) (and (numberp val) (> val 0))) -(define-key menu-bar-showhide-menu [menu-bar-mode] - `(menu-item ,(purecopy "Menu-bar") toggle-menu-bar-mode-from-frame - :help ,(purecopy "Turn menu-bar on/off") - :button - (:toggle . (menu-bar-positive-p - (frame-parameter (menu-bar-frame-for-menubar) - 'menu-bar-lines))))) - (defun menu-bar-set-tool-bar-position (position) (customize-set-variable 'tool-bar-mode t) (customize-set-variable 'tool-bar-position position)) @@ -1059,163 +980,147 @@ mail status in mode line")) (interactive) (menu-bar-set-tool-bar-position 'bottom)) -(if (featurep 'move-toolbar) - (progn - (defvar menu-bar-showhide-tool-bar-menu (make-sparse-keymap "Tool-bar")) - - (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-left] - `(menu-item ,(purecopy "On the left") - menu-bar-showhide-tool-bar-menu-customize-enable-left - :help ,(purecopy "Tool-bar at the left side") - :visible (display-graphic-p) - :button - (:radio . (and tool-bar-mode - (eq (frame-parameter - (menu-bar-frame-for-menubar) - 'tool-bar-position) - 'left))))) - - (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-right] - `(menu-item ,(purecopy "On the right") - menu-bar-showhide-tool-bar-menu-customize-enable-right - :help ,(purecopy "Tool-bar at the right side") - :visible (display-graphic-p) - :button - (:radio . (and tool-bar-mode - (eq (frame-parameter - (menu-bar-frame-for-menubar) - 'tool-bar-position) - 'right))))) - - (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-bottom] - `(menu-item ,(purecopy "On the bottom") - menu-bar-showhide-tool-bar-menu-customize-enable-bottom - :help ,(purecopy "Tool-bar at the bottom") - :visible (display-graphic-p) - :button - (:radio . (and tool-bar-mode - (eq (frame-parameter - (menu-bar-frame-for-menubar) - 'tool-bar-position) - 'bottom))))) - - (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-top] - `(menu-item ,(purecopy "On the top") - menu-bar-showhide-tool-bar-menu-customize-enable-top - :help ,(purecopy "Tool-bar at the top") - :visible (display-graphic-p) - :button - (:radio . (and tool-bar-mode - (eq (frame-parameter - (menu-bar-frame-for-menubar) - 'tool-bar-position) - 'top))))) - - (define-key menu-bar-showhide-tool-bar-menu [showhide-tool-bar-none] - `(menu-item ,(purecopy "None") - menu-bar-showhide-tool-bar-menu-customize-disable - :help ,(purecopy "Turn tool-bar off") - :visible (display-graphic-p) - :button (:radio . (eq tool-bar-mode nil)))) - - (define-key menu-bar-showhide-menu [showhide-tool-bar] - `(menu-item ,(purecopy "Tool-bar") ,menu-bar-showhide-tool-bar-menu - :visible (display-graphic-p))) - - ) - ;; else not tool bar that can move. - (define-key menu-bar-showhide-menu [showhide-tool-bar] - `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame - :help ,(purecopy "Turn tool-bar on/off") - :visible (display-graphic-p) - :button - (:toggle . (menu-bar-positive-p - (frame-parameter (menu-bar-frame-for-menubar) - 'tool-bar-lines)))))) - -(define-key menu-bar-options-menu [showhide] - `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu)) - -(define-key menu-bar-options-menu [showhide-separator] - menu-bar-separator) - -(define-key menu-bar-options-menu [mule] - ;; It is better not to use backquote here, - ;; because that makes a bootstrapping problem - ;; if you need to recompile all the Lisp files using interpreted code. - `(menu-item ,(purecopy "Multilingual Environment") ,mule-menu-keymap -;; Most of the MULE menu actually does make sense in unibyte mode, -;; e.g. language selection. -;;; :visible '(default-value 'enable-multibyte-characters) - )) -;(setq menu-bar-final-items (cons 'mule menu-bar-final-items)) -;(define-key menu-bar-options-menu [preferences] -; `(menu-item ,(purecopy "Preferences") ,menu-bar-preferences-menu -; :help ,(purecopy "Toggle important global options"))) - -(define-key menu-bar-options-menu [mule-separator] - menu-bar-separator) - -(define-key menu-bar-options-menu [debug-on-quit] - (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit - "Enter Debugger on Quit/C-g" "Debug on Quit %s" - "Enter Lisp debugger when C-g is pressed")) -(define-key menu-bar-options-menu [debug-on-error] - (menu-bar-make-toggle toggle-debug-on-error debug-on-error - "Enter Debugger on Error" "Debug on Error %s" - "Enter Lisp debugger when an error is signaled")) -(define-key menu-bar-options-menu [debugger-separator] - menu-bar-separator) - -(define-key menu-bar-options-menu [blink-cursor-mode] - (menu-bar-make-mm-toggle blink-cursor-mode - "Blinking Cursor" - "Whether the cursor blinks (Blink Cursor mode)")) -(define-key menu-bar-options-menu [cursor-separator] - menu-bar-separator) - -(define-key menu-bar-options-menu [save-place] - (menu-bar-make-toggle toggle-save-place-globally save-place - "Save Place in Files between Sessions" - "Saving place in files %s" - "Visit files of previous session when restarting Emacs" - (require 'saveplace) - ;; Do it by name, to avoid a free-variable - ;; warning during byte compilation. - (set-default - 'save-place (not (symbol-value 'save-place))))) - -(define-key menu-bar-options-menu [uniquify] - (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style - "Use Directory Names in Buffer Names" - "Directory name in buffer names (uniquify) %s" - "Uniquify buffer names by adding parent directory names" - (require 'uniquify) - (setq uniquify-buffer-name-style - (if (not uniquify-buffer-name-style) - 'forward)))) - -(define-key menu-bar-options-menu [edit-options-separator] - menu-bar-separator) -(define-key menu-bar-options-menu [cua-mode] - (menu-bar-make-mm-toggle cua-mode - "C-x/C-c/C-v Cut and Paste (CUA)" - "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste" - (:visible (or (not (boundp 'cua-enable-cua-keys)) - cua-enable-cua-keys)))) - -(define-key menu-bar-options-menu [cua-emulation-mode] - (menu-bar-make-mm-toggle cua-mode - "Shift movement mark region (CUA)" - "Use shifted movement keys to set and extend the region" - (:visible (and (boundp 'cua-enable-cua-keys) - (not cua-enable-cua-keys))))) - -(define-key menu-bar-options-menu [case-fold-search] - (menu-bar-make-toggle toggle-case-fold-search case-fold-search - "Case-Insensitive Search" - "Case-Insensitive Search %s" - "Ignore letter-case in search commands")) +(when (featurep 'move-toolbar) + (defvar menu-bar-showhide-tool-bar-menu + (let ((menu (make-sparse-keymap "Tool-bar"))) + + (define-key menu [showhide-tool-bar-left] + `(menu-item ,(purecopy "On the left") + menu-bar-showhide-tool-bar-menu-customize-enable-left + :help ,(purecopy "Tool-bar at the left side") + :visible (display-graphic-p) + :button + (:radio . (and tool-bar-mode + (eq (frame-parameter + (menu-bar-frame-for-menubar) + 'tool-bar-position) + 'left))))) + + (define-key menu [showhide-tool-bar-right] + `(menu-item ,(purecopy "On the right") + menu-bar-showhide-tool-bar-menu-customize-enable-right + :help ,(purecopy "Tool-bar at the right side") + :visible (display-graphic-p) + :button + (:radio . (and tool-bar-mode + (eq (frame-parameter + (menu-bar-frame-for-menubar) + 'tool-bar-position) + 'right))))) + + (define-key menu [showhide-tool-bar-bottom] + `(menu-item ,(purecopy "On the bottom") + menu-bar-showhide-tool-bar-menu-customize-enable-bottom + :help ,(purecopy "Tool-bar at the bottom") + :visible (display-graphic-p) + :button + (:radio . (and tool-bar-mode + (eq (frame-parameter + (menu-bar-frame-for-menubar) + 'tool-bar-position) + 'bottom))))) + + (define-key menu [showhide-tool-bar-top] + `(menu-item ,(purecopy "On the top") + menu-bar-showhide-tool-bar-menu-customize-enable-top + :help ,(purecopy "Tool-bar at the top") + :visible (display-graphic-p) + :button + (:radio . (and tool-bar-mode + (eq (frame-parameter + (menu-bar-frame-for-menubar) + 'tool-bar-position) + 'top))))) + + (define-key menu [showhide-tool-bar-none] + `(menu-item ,(purecopy "None") + menu-bar-showhide-tool-bar-menu-customize-disable + :help ,(purecopy "Turn tool-bar off") + :visible (display-graphic-p) + :button (:radio . (eq tool-bar-mode nil)))) + menu))) + +(defvar menu-bar-showhide-menu + (let ((menu (make-sparse-keymap "Show/Hide"))) + + (define-key menu [column-number-mode] + (menu-bar-make-mm-toggle column-number-mode + "Column Numbers" + "Show the current column number in the mode line")) + + (define-key menu [line-number-mode] + (menu-bar-make-mm-toggle line-number-mode + "Line Numbers" + "Show the current line number in the mode line")) + + (define-key menu [size-indication-mode] + (menu-bar-make-mm-toggle size-indication-mode + "Size Indication" + "Show the size of the buffer in the mode line")) + + (define-key menu [linecolumn-separator] + menu-bar-separator) + + (define-key menu [showhide-battery] + (menu-bar-make-mm-toggle display-battery-mode + "Battery Status" + "Display battery status information in mode line")) + + (define-key menu [showhide-date-time] + (menu-bar-make-mm-toggle display-time-mode + "Time, Load and Mail" + "Display time, system load averages and \ +mail status in mode line")) + + (define-key menu [datetime-separator] + menu-bar-separator) + + (define-key menu [showhide-speedbar] + `(menu-item ,(purecopy "Speedbar") speedbar-frame-mode + :help ,(purecopy "Display a Speedbar quick-navigation frame") + :button (:toggle + . (and (boundp 'speedbar-frame) + (frame-live-p (symbol-value 'speedbar-frame)) + (frame-visible-p + (symbol-value 'speedbar-frame)))))) + + (define-key menu [showhide-fringe] + `(menu-item ,(purecopy "Fringe") ,menu-bar-showhide-fringe-menu + :visible (display-graphic-p))) + + (define-key menu [showhide-scroll-bar] + `(menu-item ,(purecopy "Scroll-bar") ,menu-bar-showhide-scroll-bar-menu + :visible (display-graphic-p))) + + (define-key menu [showhide-tooltip-mode] + `(menu-item ,(purecopy "Tooltips") tooltip-mode + :help ,(purecopy "Turn tooltips on/off") + :visible (and (display-graphic-p) (fboundp 'x-show-tip)) + :button (:toggle . tooltip-mode))) + + (define-key menu [menu-bar-mode] + `(menu-item ,(purecopy "Menu-bar") toggle-menu-bar-mode-from-frame + :help ,(purecopy "Turn menu-bar on/off") + :button + (:toggle . (menu-bar-positive-p + (frame-parameter (menu-bar-frame-for-menubar) + 'menu-bar-lines))))) + + (if (and (boundp 'menu-bar-showhide-tool-bar-menu) + (keymapp menu-bar-showhide-tool-bar-menu)) + (define-key menu [showhide-tool-bar] + `(menu-item ,(purecopy "Tool-bar") ,menu-bar-showhide-tool-bar-menu + :visible (display-graphic-p))) + ;; else not tool bar that can move. + (define-key menu [showhide-tool-bar] + `(menu-item ,(purecopy "Tool-bar") toggle-tool-bar-mode-from-frame + :help ,(purecopy "Turn tool-bar on/off") + :visible (display-graphic-p) + :button + (:toggle . (menu-bar-positive-p + (frame-parameter (menu-bar-frame-for-menubar) + 'tool-bar-lines)))))) + menu)) (defun menu-bar-text-mode-auto-fill () (interactive) @@ -1225,71 +1130,187 @@ mail status in mode line")) ;; -- Per Abrahamsen <[email protected]> 2002-02-11. (customize-mark-as-set 'text-mode-hook)) -(define-key menu-bar-options-menu [auto-fill-mode] - `(menu-item ,(purecopy "Auto Fill in Text Modes") - menu-bar-text-mode-auto-fill - :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)") - :button (:toggle . (if (listp text-mode-hook) - (member 'turn-on-auto-fill text-mode-hook) - (eq 'turn-on-auto-fill text-mode-hook))))) - - -(defvar menu-bar-line-wrapping-menu (make-sparse-keymap "Line Wrapping")) - -(define-key menu-bar-line-wrapping-menu [word-wrap] - `(menu-item ,(purecopy "Word Wrap (Visual Line mode)") - (lambda () - (interactive) - (unless visual-line-mode - (visual-line-mode 1)) - (message ,(purecopy "Visual-Line mode enabled"))) - :help ,(purecopy "Wrap long lines at word boundaries") - :button (:radio . (and (null truncate-lines) - (not (truncated-partial-width-window-p)) - word-wrap)) - :visible (menu-bar-menu-frame-live-and-visible-p))) - -(define-key menu-bar-line-wrapping-menu [truncate] - `(menu-item ,(purecopy "Truncate Long Lines") - (lambda () - (interactive) - (if visual-line-mode (visual-line-mode 0)) - (setq word-wrap nil) - (toggle-truncate-lines 1)) - :help ,(purecopy "Truncate long lines at window edge") - :button (:radio . (or truncate-lines - (truncated-partial-width-window-p))) - :visible (menu-bar-menu-frame-live-and-visible-p) - :enable (not (truncated-partial-width-window-p)))) - -(define-key menu-bar-line-wrapping-menu [window-wrap] - `(menu-item ,(purecopy "Wrap at Window Edge") - (lambda () (interactive) - (if visual-line-mode (visual-line-mode 0)) - (setq word-wrap nil) - (if truncate-lines (toggle-truncate-lines -1))) - :help ,(purecopy "Wrap long lines at window edge") - :button (:radio . (and (null truncate-lines) - (not (truncated-partial-width-window-p)) - (not word-wrap))) - :visible (menu-bar-menu-frame-live-and-visible-p) - :enable (not (truncated-partial-width-window-p)))) - -(define-key menu-bar-options-menu [line-wrapping] - `(menu-item ,(purecopy "Line Wrapping in this Buffer") ,menu-bar-line-wrapping-menu)) - - -(define-key menu-bar-options-menu [highlight-separator] - menu-bar-separator) -(define-key menu-bar-options-menu [highlight-paren-mode] - (menu-bar-make-mm-toggle show-paren-mode - "Paren Match Highlighting" - "Highlight matching/mismatched parentheses at cursor (Show Paren mode)")) -(define-key menu-bar-options-menu [transient-mark-mode] - (menu-bar-make-mm-toggle transient-mark-mode - "Active Region Highlighting" - "Make text in active region stand out in color (Transient Mark mode)" - (:enable (not cua-mode)))) + +(defvar menu-bar-line-wrapping-menu + (let ((menu (make-sparse-keymap "Line Wrapping"))) + + (define-key menu [word-wrap] + `(menu-item ,(purecopy "Word Wrap (Visual Line mode)") + (lambda () + (interactive) + (unless visual-line-mode + (visual-line-mode 1)) + (message ,(purecopy "Visual-Line mode enabled"))) + :help ,(purecopy "Wrap long lines at word boundaries") + :button (:radio . (and (null truncate-lines) + (not (truncated-partial-width-window-p)) + word-wrap)) + :visible (menu-bar-menu-frame-live-and-visible-p))) + + (define-key menu [truncate] + `(menu-item ,(purecopy "Truncate Long Lines") + (lambda () + (interactive) + (if visual-line-mode (visual-line-mode 0)) + (setq word-wrap nil) + (toggle-truncate-lines 1)) + :help ,(purecopy "Truncate long lines at window edge") + :button (:radio . (or truncate-lines + (truncated-partial-width-window-p))) + :visible (menu-bar-menu-frame-live-and-visible-p) + :enable (not (truncated-partial-width-window-p)))) + + (define-key menu [window-wrap] + `(menu-item ,(purecopy "Wrap at Window Edge") + (lambda () (interactive) + (if visual-line-mode (visual-line-mode 0)) + (setq word-wrap nil) + (if truncate-lines (toggle-truncate-lines -1))) + :help ,(purecopy "Wrap long lines at window edge") + :button (:radio . (and (null truncate-lines) + (not (truncated-partial-width-window-p)) + (not word-wrap))) + :visible (menu-bar-menu-frame-live-and-visible-p) + :enable (not (truncated-partial-width-window-p)))) + menu)) + +(defvar menu-bar-options-menu + (let ((menu (make-sparse-keymap "Options"))) + (define-key menu [customize] + `(menu-item ,(purecopy "Customize Emacs") ,menu-bar-custom-menu)) + + (define-key menu [package] + '(menu-item "Manage Emacs Packages" package-list-packages + :help "Install or uninstall additional Emacs packages")) + + (define-key menu [save] + `(menu-item ,(purecopy "Save Options") menu-bar-options-save + :help ,(purecopy "Save options set from the menu above"))) + + (define-key menu [custom-separator] + menu-bar-separator) + + (define-key menu [menu-set-font] + `(menu-item ,(purecopy "Set Default Font...") menu-set-font + :visible (display-multi-font-p) + :help ,(purecopy "Select a default font"))) + + (if (featurep 'system-font-setting) + (define-key menu [menu-system-font] + (menu-bar-make-toggle + toggle-use-system-font font-use-system-font + "Use system font" + "Use system font: %s" + "Use the monospaced font defined by the system"))) + + (define-key menu [showhide] + `(menu-item ,(purecopy "Show/Hide") ,menu-bar-showhide-menu)) + + (define-key menu [showhide-separator] + menu-bar-separator) + + (define-key menu [mule] + ;; It is better not to use backquote here, + ;; because that makes a bootstrapping problem + ;; if you need to recompile all the Lisp files using interpreted code. + `(menu-item ,(purecopy "Multilingual Environment") ,mule-menu-keymap + ;; Most of the MULE menu actually does make sense in + ;; unibyte mode, e.g. language selection. + ;; :visible '(default-value 'enable-multibyte-characters) + )) + ;;(setq menu-bar-final-items (cons 'mule menu-bar-final-items)) + ;;(define-key menu [preferences] + ;; `(menu-item ,(purecopy "Preferences") ,menu-bar-preferences-menu + ;; :help ,(purecopy "Toggle important global options"))) + + (define-key menu [mule-separator] + menu-bar-separator) + + (define-key menu [debug-on-quit] + (menu-bar-make-toggle toggle-debug-on-quit debug-on-quit + "Enter Debugger on Quit/C-g" "Debug on Quit %s" + "Enter Lisp debugger when C-g is pressed")) + (define-key menu [debug-on-error] + (menu-bar-make-toggle toggle-debug-on-error debug-on-error + "Enter Debugger on Error" "Debug on Error %s" + "Enter Lisp debugger when an error is signaled")) + (define-key menu [debugger-separator] + menu-bar-separator) + + (define-key menu [blink-cursor-mode] + (menu-bar-make-mm-toggle blink-cursor-mode + "Blinking Cursor" + "Whether the cursor blinks (Blink Cursor mode)")) + (define-key menu [cursor-separator] + menu-bar-separator) + + (define-key menu [save-place] + (menu-bar-make-toggle toggle-save-place-globally save-place + "Save Place in Files between Sessions" + "Saving place in files %s" + "Visit files of previous session when restarting Emacs" + (require 'saveplace) + ;; Do it by name, to avoid a free-variable + ;; warning during byte compilation. + (set-default + 'save-place (not (symbol-value 'save-place))))) + + (define-key menu [uniquify] + (menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style + "Use Directory Names in Buffer Names" + "Directory name in buffer names (uniquify) %s" + "Uniquify buffer names by adding parent directory names" + (require 'uniquify) + (setq uniquify-buffer-name-style + (if (not uniquify-buffer-name-style) + 'forward)))) + + (define-key menu [edit-options-separator] + menu-bar-separator) + (define-key menu [cua-mode] + (menu-bar-make-mm-toggle cua-mode + "C-x/C-c/C-v Cut and Paste (CUA)" + "Use C-z/C-x/C-c/C-v keys for undo/cut/copy/paste" + (:visible (or (not (boundp 'cua-enable-cua-keys)) + cua-enable-cua-keys)))) + + (define-key menu [cua-emulation-mode] + (menu-bar-make-mm-toggle cua-mode + "Shift movement mark region (CUA)" + "Use shifted movement keys to set and extend the region" + (:visible (and (boundp 'cua-enable-cua-keys) + (not cua-enable-cua-keys))))) + + (define-key menu [case-fold-search] + (menu-bar-make-toggle toggle-case-fold-search case-fold-search + "Case-Insensitive Search" + "Case-Insensitive Search %s" + "Ignore letter-case in search commands")) + + (define-key menu [auto-fill-mode] + `(menu-item ,(purecopy "Auto Fill in Text Modes") + menu-bar-text-mode-auto-fill + :help ,(purecopy "Automatically fill text while typing (Auto Fill mode)") + :button (:toggle . (if (listp text-mode-hook) + (member 'turn-on-auto-fill text-mode-hook) + (eq 'turn-on-auto-fill text-mode-hook))))) + + (define-key menu [line-wrapping] + `(menu-item ,(purecopy "Line Wrapping in this Buffer") ,menu-bar-line-wrapping-menu)) + + + (define-key menu [highlight-separator] + menu-bar-separator) + (define-key menu [highlight-paren-mode] + (menu-bar-make-mm-toggle show-paren-mode + "Paren Match Highlighting" + "Highlight matching/mismatched parentheses at cursor (Show Paren mode)")) + (define-key menu [transient-mark-mode] + (menu-bar-make-mm-toggle transient-mark-mode + "Active Region Highlighting" + "Make text in active region stand out in color (Transient Mark mode)" + (:enable (not cua-mode)))) + menu)) ;; The "Tools" menu items @@ -1314,270 +1335,276 @@ mail status in mode line")) (known (assq read-mail-command known-rmail-commands))) (if known (cdr known) (symbol-name read-mail-command)))) -(defvar menu-bar-games-menu (make-sparse-keymap "Games")) - -(define-key menu-bar-tools-menu [games] - `(menu-item ,(purecopy "Games") ,menu-bar-games-menu)) - -(define-key menu-bar-tools-menu [separator-games] - menu-bar-separator) - -(define-key menu-bar-games-menu [zone] - `(menu-item ,(purecopy "Zone Out") zone - :help ,(purecopy "Play tricks with Emacs display when Emacs is idle"))) -(define-key menu-bar-games-menu [tetris] - `(menu-item ,(purecopy "Tetris") tetris - :help ,(purecopy "Falling blocks game"))) -(define-key menu-bar-games-menu [solitaire] - `(menu-item ,(purecopy "Solitaire") solitaire - :help ,(purecopy "Get rid of all the stones"))) -(define-key menu-bar-games-menu [snake] - `(menu-item ,(purecopy "Snake") snake - :help ,(purecopy "Move snake around avoiding collisions"))) -(define-key menu-bar-games-menu [pong] - `(menu-item ,(purecopy "Pong") pong - :help ,(purecopy "Bounce the ball to your opponent"))) -(define-key menu-bar-games-menu [mult] - `(menu-item ,(purecopy "Multiplication Puzzle") mpuz - :help ,(purecopy "Exercise brain with multiplication"))) -(define-key menu-bar-games-menu [life] - `(menu-item ,(purecopy "Life") life - :help ,(purecopy "Watch how John Conway's cellular automaton evolves"))) -(define-key menu-bar-games-menu [land] - `(menu-item ,(purecopy "Landmark") landmark - :help ,(purecopy "Watch a neural-network robot learn landmarks"))) -(define-key menu-bar-games-menu [hanoi] - `(menu-item ,(purecopy "Towers of Hanoi") hanoi - :help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs"))) -(define-key menu-bar-games-menu [gomoku] - `(menu-item ,(purecopy "Gomoku") gomoku - :help ,(purecopy "Mark 5 contiguous squares (like tic-tac-toe)"))) -(define-key menu-bar-games-menu [bubbles] - `(menu-item ,(purecopy "Bubbles") bubbles - :help ,(purecopy "Remove all bubbles using the fewest moves"))) -(define-key menu-bar-games-menu [black-box] - `(menu-item ,(purecopy "Blackbox") blackbox - :help ,(purecopy "Find balls in a black box by shooting rays"))) -(define-key menu-bar-games-menu [adventure] - `(menu-item ,(purecopy "Adventure") dunnet - :help ,(purecopy "Dunnet, a text Adventure game for Emacs"))) -(define-key menu-bar-games-menu [5x5] - `(menu-item ,(purecopy "5x5") 5x5 - :help ,(purecopy "Fill in all the squares on a 5x5 board"))) +(defvar menu-bar-games-menu + (let ((menu (make-sparse-keymap "Games"))) + + (define-key menu [zone] + `(menu-item ,(purecopy "Zone Out") zone + :help ,(purecopy "Play tricks with Emacs display when Emacs is idle"))) + (define-key menu [tetris] + `(menu-item ,(purecopy "Tetris") tetris + :help ,(purecopy "Falling blocks game"))) + (define-key menu [solitaire] + `(menu-item ,(purecopy "Solitaire") solitaire + :help ,(purecopy "Get rid of all the stones"))) + (define-key menu [snake] + `(menu-item ,(purecopy "Snake") snake + :help ,(purecopy "Move snake around avoiding collisions"))) + (define-key menu [pong] + `(menu-item ,(purecopy "Pong") pong + :help ,(purecopy "Bounce the ball to your opponent"))) + (define-key menu [mult] + `(menu-item ,(purecopy "Multiplication Puzzle") mpuz + :help ,(purecopy "Exercise brain with multiplication"))) + (define-key menu [life] + `(menu-item ,(purecopy "Life") life + :help ,(purecopy "Watch how John Conway's cellular automaton evolves"))) + (define-key menu [land] + `(menu-item ,(purecopy "Landmark") landmark + :help ,(purecopy "Watch a neural-network robot learn landmarks"))) + (define-key menu [hanoi] + `(menu-item ,(purecopy "Towers of Hanoi") hanoi + :help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs"))) + (define-key menu [gomoku] + `(menu-item ,(purecopy "Gomoku") gomoku + :help ,(purecopy "Mark 5 contiguous squares (like tic-tac-toe)"))) + (define-key menu [bubbles] + `(menu-item ,(purecopy "Bubbles") bubbles + :help ,(purecopy "Remove all bubbles using the fewest moves"))) + (define-key menu [black-box] + `(menu-item ,(purecopy "Blackbox") blackbox + :help ,(purecopy "Find balls in a black box by shooting rays"))) + (define-key menu [adventure] + `(menu-item ,(purecopy "Adventure") dunnet + :help ,(purecopy "Dunnet, a text Adventure game for Emacs"))) + (define-key menu [5x5] + `(menu-item ,(purecopy "5x5") 5x5 + :help ,(purecopy "Fill in all the squares on a 5x5 board"))) + menu)) (defvar menu-bar-encryption-decryption-menu - (make-sparse-keymap "Encryption/Decryption")) - -(define-key menu-bar-tools-menu [encryption-decryption] - `(menu-item ,(purecopy "Encryption/Decryption") ,menu-bar-encryption-decryption-menu)) - -(define-key menu-bar-tools-menu [separator-encryption-decryption] - menu-bar-separator) - -(define-key menu-bar-encryption-decryption-menu [insert-keys] - `(menu-item ,(purecopy "Insert Keys") epa-insert-keys - :help ,(purecopy "Insert public keys after the current point"))) - -(define-key menu-bar-encryption-decryption-menu [export-keys] - `(menu-item ,(purecopy "Export Keys") epa-export-keys - :help ,(purecopy "Export public keys to a file"))) - -(define-key menu-bar-encryption-decryption-menu [import-keys-region] - `(menu-item ,(purecopy "Import Keys from Region") epa-import-keys-region - :help ,(purecopy "Import public keys from the current region"))) - -(define-key menu-bar-encryption-decryption-menu [import-keys] - `(menu-item ,(purecopy "Import Keys from File...") epa-import-keys - :help ,(purecopy "Import public keys from a file"))) - -(define-key menu-bar-encryption-decryption-menu [list-keys] - `(menu-item ,(purecopy "List Keys") epa-list-keys - :help ,(purecopy "Browse your public keyring"))) - -(define-key menu-bar-encryption-decryption-menu [separator-keys] - menu-bar-separator) - -(define-key menu-bar-encryption-decryption-menu [sign-region] - `(menu-item ,(purecopy "Sign Region") epa-sign-region - :help ,(purecopy "Create digital signature of the current region"))) - -(define-key menu-bar-encryption-decryption-menu [verify-region] - `(menu-item ,(purecopy "Verify Region") epa-verify-region - :help ,(purecopy "Verify digital signature of the current region"))) - -(define-key menu-bar-encryption-decryption-menu [encrypt-region] - `(menu-item ,(purecopy "Encrypt Region") epa-encrypt-region - :help ,(purecopy "Encrypt the current region"))) - -(define-key menu-bar-encryption-decryption-menu [decrypt-region] - `(menu-item ,(purecopy "Decrypt Region") epa-decrypt-region - :help ,(purecopy "Decrypt the current region"))) - -(define-key menu-bar-encryption-decryption-menu [separator-file] - menu-bar-separator) - -(define-key menu-bar-encryption-decryption-menu [sign-file] - `(menu-item ,(purecopy "Sign File...") epa-sign-file - :help ,(purecopy "Create digital signature of a file"))) - -(define-key menu-bar-encryption-decryption-menu [verify-file] - `(menu-item ,(purecopy "Verify File...") epa-verify-file - :help ,(purecopy "Verify digital signature of a file"))) - -(define-key menu-bar-encryption-decryption-menu [encrypt-file] - `(menu-item ,(purecopy "Encrypt File...") epa-encrypt-file - :help ,(purecopy "Encrypt a file"))) - -(define-key menu-bar-encryption-decryption-menu [decrypt-file] - `(menu-item ,(purecopy "Decrypt File...") epa-decrypt-file - :help ,(purecopy "Decrypt a file"))) - -(define-key menu-bar-tools-menu [simple-calculator] - `(menu-item ,(purecopy "Simple Calculator") calculator - :help ,(purecopy "Invoke the Emacs built-in quick calculator"))) -(define-key menu-bar-tools-menu [calc] - `(menu-item ,(purecopy "Programmable Calculator") calc - :help ,(purecopy "Invoke the Emacs built-in full scientific calculator"))) -(define-key menu-bar-tools-menu [calendar] - `(menu-item ,(purecopy "Calendar") calendar - :help ,(purecopy "Invoke the Emacs built-in calendar"))) - -(define-key menu-bar-tools-menu [separator-net] - menu-bar-separator) - -(define-key menu-bar-tools-menu [directory-search] - `(menu-item ,(purecopy "Directory Search") eudc-tools-menu)) -(define-key menu-bar-tools-menu [compose-mail] - `(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail - :visible (and mail-user-agent (not (eq mail-user-agent 'ignore))) - :help ,(purecopy "Send a mail message"))) -(define-key menu-bar-tools-menu [rmail] - `(menu-item (format "Read Mail (with %s)" (read-mail-item-name)) - menu-bar-read-mail - :visible (and read-mail-command - (not (eq read-mail-command 'ignore))) - :help ,(purecopy "Read your mail and reply to it"))) + (let ((menu (make-sparse-keymap "Encryption/Decryption"))) + (define-key menu [insert-keys] + `(menu-item ,(purecopy "Insert Keys") epa-insert-keys + :help ,(purecopy "Insert public keys after the current point"))) + + (define-key menu [export-keys] + `(menu-item ,(purecopy "Export Keys") epa-export-keys + :help ,(purecopy "Export public keys to a file"))) + + (define-key menu [import-keys-region] + `(menu-item ,(purecopy "Import Keys from Region") epa-import-keys-region + :help ,(purecopy "Import public keys from the current region"))) + + (define-key menu [import-keys] + `(menu-item ,(purecopy "Import Keys from File...") epa-import-keys + :help ,(purecopy "Import public keys from a file"))) + + (define-key menu [list-keys] + `(menu-item ,(purecopy "List Keys") epa-list-keys + :help ,(purecopy "Browse your public keyring"))) + + (define-key menu [separator-keys] + menu-bar-separator) + + (define-key menu [sign-region] + `(menu-item ,(purecopy "Sign Region") epa-sign-region + :help ,(purecopy "Create digital signature of the current region"))) + + (define-key menu [verify-region] + `(menu-item ,(purecopy "Verify Region") epa-verify-region + :help ,(purecopy "Verify digital signature of the current region"))) + + (define-key menu [encrypt-region] + `(menu-item ,(purecopy "Encrypt Region") epa-encrypt-region + :help ,(purecopy "Encrypt the current region"))) + + (define-key menu [decrypt-region] + `(menu-item ,(purecopy "Decrypt Region") epa-decrypt-region + :help ,(purecopy "Decrypt the current region"))) + + (define-key menu [separator-file] + menu-bar-separator) + + (define-key menu [sign-file] + `(menu-item ,(purecopy "Sign File...") epa-sign-file + :help ,(purecopy "Create digital signature of a file"))) + + (define-key menu [verify-file] + `(menu-item ,(purecopy "Verify File...") epa-verify-file + :help ,(purecopy "Verify digital signature of a file"))) + + (define-key menu [encrypt-file] + `(menu-item ,(purecopy "Encrypt File...") epa-encrypt-file + :help ,(purecopy "Encrypt a file"))) + + (define-key menu [decrypt-file] + `(menu-item ,(purecopy "Decrypt File...") epa-decrypt-file + :help ,(purecopy "Decrypt a file"))) + + menu)) (defun menu-bar-read-mail () "Read mail using `read-mail-command'." (interactive) (call-interactively read-mail-command)) -(define-key menu-bar-tools-menu [gnus] - `(menu-item ,(purecopy "Read Net News (Gnus)") gnus - :help ,(purecopy "Read network news groups"))) - -(define-key menu-bar-tools-menu [separator-vc] - menu-bar-separator) - -(define-key menu-bar-tools-menu [pcl-cvs] - `(menu-item ,(purecopy "PCL-CVS") cvs-global-menu)) -(define-key menu-bar-tools-menu [vc] nil) ;Create the place for the VC menu. - -(define-key menu-bar-tools-menu [separator-compare] - menu-bar-separator) - -(define-key menu-bar-tools-menu [epatch] - `(menu-item ,(purecopy "Apply Patch") menu-bar-epatch-menu)) -(define-key menu-bar-tools-menu [ediff-merge] - `(menu-item ,(purecopy "Merge") menu-bar-ediff-merge-menu)) -(define-key menu-bar-tools-menu [compare] - `(menu-item ,(purecopy "Compare (Ediff)") menu-bar-ediff-menu)) - -(define-key menu-bar-tools-menu [separator-spell] - menu-bar-separator) - -(define-key menu-bar-tools-menu [spell] - `(menu-item ,(purecopy "Spell Checking") ispell-menu-map)) - -(define-key menu-bar-tools-menu [separator-prog] - menu-bar-separator) - -(define-key menu-bar-tools-menu [semantic] - `(menu-item ,(purecopy "Source Code Parsers (Semantic)") - semantic-mode - :help ,(purecopy "Toggle automatic parsing in source code buffers (Semantic mode)") - :button (:toggle . (bound-and-true-p semantic-mode)))) - -(define-key menu-bar-tools-menu [ede] - `(menu-item ,(purecopy "Project support (EDE)") - global-ede-mode - :help ,(purecopy "Toggle the Emacs Development Environment (Global EDE mode)") - :button (:toggle . (bound-and-true-p global-ede-mode)))) - -(define-key menu-bar-tools-menu [gdb] - `(menu-item ,(purecopy "Debugger (GDB)...") gdb - :help ,(purecopy "Debug a program from within Emacs with GDB"))) -(define-key menu-bar-tools-menu [shell-on-region] - `(menu-item ,(purecopy "Shell Command on Region...") shell-command-on-region - :enable mark-active - :help ,(purecopy "Pass marked region to a shell command"))) -(define-key menu-bar-tools-menu [shell] - `(menu-item ,(purecopy "Shell Command...") shell-command - :help ,(purecopy "Invoke a shell command and catch its output"))) -(define-key menu-bar-tools-menu [compile] - `(menu-item ,(purecopy "Compile...") compile - :help ,(purecopy "Invoke compiler or Make, view compilation errors"))) -(define-key menu-bar-tools-menu [grep] - `(menu-item ,(purecopy "Search Files (Grep)...") grep - :help ,(purecopy "Search files for strings or regexps (with Grep)"))) - +(defvar menu-bar-tools-menu + (let ((menu (make-sparse-keymap "Tools"))) + + (define-key menu [games] + `(menu-item ,(purecopy "Games") ,menu-bar-games-menu)) + + (define-key menu [separator-games] + menu-bar-separator) + + (define-key menu [encryption-decryption] + `(menu-item ,(purecopy "Encryption/Decryption") ,menu-bar-encryption-decryption-menu)) + + (define-key menu [separator-encryption-decryption] + menu-bar-separator) + + (define-key menu [simple-calculator] + `(menu-item ,(purecopy "Simple Calculator") calculator + :help ,(purecopy "Invoke the Emacs built-in quick calculator"))) + (define-key menu [calc] + `(menu-item ,(purecopy "Programmable Calculator") calc + :help ,(purecopy "Invoke the Emacs built-in full scientific calculator"))) + (define-key menu [calendar] + `(menu-item ,(purecopy "Calendar") calendar + :help ,(purecopy "Invoke the Emacs built-in calendar"))) + + (define-key menu [separator-net] + menu-bar-separator) + + (define-key menu [directory-search] + `(menu-item ,(purecopy "Directory Search") eudc-tools-menu)) + (define-key menu [compose-mail] + `(menu-item (format "Send Mail (with %s)" (send-mail-item-name)) compose-mail + :visible (and mail-user-agent (not (eq mail-user-agent 'ignore))) + :help ,(purecopy "Send a mail message"))) + (define-key menu [rmail] + `(menu-item (format "Read Mail (with %s)" (read-mail-item-name)) + menu-bar-read-mail + :visible (and read-mail-command + (not (eq read-mail-command 'ignore))) + :help ,(purecopy "Read your mail and reply to it"))) + + (define-key menu [gnus] + `(menu-item ,(purecopy "Read Net News (Gnus)") gnus + :help ,(purecopy "Read network news groups"))) + + (define-key menu [separator-vc] + menu-bar-separator) + + (define-key menu [pcl-cvs] + `(menu-item ,(purecopy "PCL-CVS") cvs-global-menu)) + (define-key menu [vc] nil) ;Create the place for the VC menu. + + (define-key menu [separator-compare] + menu-bar-separator) + + (define-key menu [epatch] + `(menu-item ,(purecopy "Apply Patch") menu-bar-epatch-menu)) + (define-key menu [ediff-merge] + `(menu-item ,(purecopy "Merge") menu-bar-ediff-merge-menu)) + (define-key menu [compare] + `(menu-item ,(purecopy "Compare (Ediff)") menu-bar-ediff-menu)) + + (define-key menu [separator-spell] + menu-bar-separator) + + (define-key menu [spell] + `(menu-item ,(purecopy "Spell Checking") ispell-menu-map)) + + (define-key menu [separator-prog] + menu-bar-separator) + + (define-key menu [semantic] + `(menu-item ,(purecopy "Source Code Parsers (Semantic)") + semantic-mode + :help ,(purecopy "Toggle automatic parsing in source code buffers (Semantic mode)") + :button (:toggle . (bound-and-true-p semantic-mode)))) + + (define-key menu [ede] + `(menu-item ,(purecopy "Project support (EDE)") + global-ede-mode + :help ,(purecopy "Toggle the Emacs Development Environment (Global EDE mode)") + :button (:toggle . (bound-and-true-p global-ede-mode)))) + + (define-key menu [gdb] + `(menu-item ,(purecopy "Debugger (GDB)...") gdb + :help ,(purecopy "Debug a program from within Emacs with GDB"))) + (define-key menu [shell-on-region] + `(menu-item ,(purecopy "Shell Command on Region...") shell-command-on-region + :enable mark-active + :help ,(purecopy "Pass marked region to a shell command"))) + (define-key menu [shell] + `(menu-item ,(purecopy "Shell Command...") shell-command + :help ,(purecopy "Invoke a shell command and catch its output"))) + (define-key menu [compile] + `(menu-item ,(purecopy "Compile...") compile + :help ,(purecopy "Invoke compiler or Make, view compilation errors"))) + (define-key menu [grep] + `(menu-item ,(purecopy "Search Files (Grep)...") grep + :help ,(purecopy "Search files for strings or regexps (with Grep)"))) + menu)) ;; The "Help" menu items -(defvar menu-bar-describe-menu (make-sparse-keymap "Describe")) - -(define-key menu-bar-describe-menu [mule-diag] - `(menu-item ,(purecopy "Show All of Mule Status") mule-diag - :visible (default-value 'enable-multibyte-characters) - :help ,(purecopy "Display multilingual environment settings"))) -(define-key menu-bar-describe-menu [describe-coding-system-briefly] - `(menu-item ,(purecopy "Describe Coding System (Briefly)") - describe-current-coding-system-briefly - :visible (default-value 'enable-multibyte-characters))) -(define-key menu-bar-describe-menu [describe-coding-system] - `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system - :visible (default-value 'enable-multibyte-characters))) -(define-key menu-bar-describe-menu [describe-input-method] - `(menu-item ,(purecopy "Describe Input Method...") describe-input-method - :visible (default-value 'enable-multibyte-characters) - :help ,(purecopy "Keyboard layout for specific input method"))) -(define-key menu-bar-describe-menu [describe-language-environment] - `(menu-item ,(purecopy "Describe Language Environment") - ,describe-language-environment-map)) - -(define-key menu-bar-describe-menu [separator-desc-mule] - menu-bar-separator) - -(define-key menu-bar-describe-menu [list-keybindings] - `(menu-item ,(purecopy "List Key Bindings") describe-bindings - :help ,(purecopy "Display all current key bindings (keyboard shortcuts)"))) -(define-key menu-bar-describe-menu [describe-current-display-table] - `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table - :help ,(purecopy "Describe the current display table"))) -(define-key menu-bar-describe-menu [describe-package] - `(menu-item ,(purecopy "Describe Package...") describe-package - :help ,(purecopy "Display documentation of a Lisp package"))) -(define-key menu-bar-describe-menu [describe-face] - `(menu-item ,(purecopy "Describe Face...") describe-face - :help ,(purecopy "Display the properties of a face"))) -(define-key menu-bar-describe-menu [describe-variable] - `(menu-item ,(purecopy "Describe Variable...") describe-variable - :help ,(purecopy "Display documentation of variable/option"))) -(define-key menu-bar-describe-menu [describe-function] - `(menu-item ,(purecopy "Describe Function...") describe-function - :help ,(purecopy "Display documentation of function/command"))) -(define-key menu-bar-describe-menu [describe-key-1] - `(menu-item ,(purecopy "Describe Key or Mouse Operation...") describe-key - ;; Users typically don't identify keys and menu items... - :help ,(purecopy "Display documentation of command bound to a \ +(defvar menu-bar-describe-menu + (let ((menu (make-sparse-keymap "Describe"))) + + (define-key menu [mule-diag] + `(menu-item ,(purecopy "Show All of Mule Status") mule-diag + :visible (default-value 'enable-multibyte-characters) + :help ,(purecopy "Display multilingual environment settings"))) + (define-key menu [describe-coding-system-briefly] + `(menu-item ,(purecopy "Describe Coding System (Briefly)") + describe-current-coding-system-briefly + :visible (default-value 'enable-multibyte-characters))) + (define-key menu [describe-coding-system] + `(menu-item ,(purecopy "Describe Coding System...") describe-coding-system + :visible (default-value 'enable-multibyte-characters))) + (define-key menu [describe-input-method] + `(menu-item ,(purecopy "Describe Input Method...") describe-input-method + :visible (default-value 'enable-multibyte-characters) + :help ,(purecopy "Keyboard layout for specific input method"))) + (define-key menu [describe-language-environment] + `(menu-item ,(purecopy "Describe Language Environment") + ,describe-language-environment-map)) + + (define-key menu [separator-desc-mule] + menu-bar-separator) + + (define-key menu [list-keybindings] + `(menu-item ,(purecopy "List Key Bindings") describe-bindings + :help ,(purecopy "Display all current key bindings (keyboard shortcuts)"))) + (define-key menu [describe-current-display-table] + `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table + :help ,(purecopy "Describe the current display table"))) + (define-key menu [describe-package] + `(menu-item ,(purecopy "Describe Package...") describe-package + :help ,(purecopy "Display documentation of a Lisp package"))) + (define-key menu [describe-face] + `(menu-item ,(purecopy "Describe Face...") describe-face + :help ,(purecopy "Display the properties of a face"))) + (define-key menu [describe-variable] + `(menu-item ,(purecopy "Describe Variable...") describe-variable + :help ,(purecopy "Display documentation of variable/option"))) + (define-key menu [describe-function] + `(menu-item ,(purecopy "Describe Function...") describe-function + :help ,(purecopy "Display documentation of function/command"))) + (define-key menu [describe-key-1] + `(menu-item ,(purecopy "Describe Key or Mouse Operation...") describe-key + ;; Users typically don't identify keys and menu items... + :help ,(purecopy "Display documentation of command bound to a \ key, a click, or a menu-item"))) -(define-key menu-bar-describe-menu [describe-mode] - `(menu-item ,(purecopy "Describe Buffer Modes") describe-mode - :help ,(purecopy "Describe this buffer's major and minor mode"))) + (define-key menu [describe-mode] + `(menu-item ,(purecopy "Describe Buffer Modes") describe-mode + :help ,(purecopy "Describe this buffer's major and minor mode"))) + menu)) -(defvar menu-bar-search-documentation-menu - (make-sparse-keymap "Search Documentation")) (defun menu-bar-read-lispref () "Display the Emacs Lisp Reference manual in Info mode." (interactive) @@ -1605,80 +1632,69 @@ key, a click, or a menu-item"))) (info "elisp") (Info-index topic)) -(define-key menu-bar-search-documentation-menu [search-documentation-strings] - `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation - :help - ,(purecopy "Find functions and variables whose doc strings match a regexp"))) -(define-key menu-bar-search-documentation-menu [find-any-object-by-name] - `(menu-item ,(purecopy "Find Any Object by Name...") apropos - :help ,(purecopy "Find symbols of any kind whose names match a regexp"))) -(define-key menu-bar-search-documentation-menu [find-option-by-value] - `(menu-item ,(purecopy "Find Options by Value...") apropos-value - :help ,(purecopy "Find variables whose values match a regexp"))) -(define-key menu-bar-search-documentation-menu [find-options-by-name] - `(menu-item ,(purecopy "Find Options by Name...") apropos-variable - :help ,(purecopy "Find variables whose names match a regexp"))) -(define-key menu-bar-search-documentation-menu [find-commands-by-name] - `(menu-item ,(purecopy "Find Commands by Name...") apropos-command - :help ,(purecopy "Find commands whose names match a regexp"))) -(define-key menu-bar-search-documentation-menu [sep1] - menu-bar-separator) -(define-key menu-bar-search-documentation-menu [lookup-command-in-manual] - `(menu-item ,(purecopy "Look Up Command in User Manual...") Info-goto-emacs-command-node - :help ,(purecopy "Display manual section that describes a command"))) -(define-key menu-bar-search-documentation-menu [lookup-key-in-manual] - `(menu-item ,(purecopy "Look Up Key in User Manual...") Info-goto-emacs-key-command-node - :help ,(purecopy "Display manual section that describes a key"))) -(define-key menu-bar-search-documentation-menu [lookup-subject-in-elisp-manual] - `(menu-item ,(purecopy "Look Up Subject in ELisp Manual...") elisp-index-search - :help ,(purecopy "Find description of a subject in Emacs Lisp manual"))) -(define-key menu-bar-search-documentation-menu [lookup-subject-in-emacs-manual] - `(menu-item ,(purecopy "Look Up Subject in User Manual...") emacs-index-search - :help ,(purecopy "Find description of a subject in Emacs User manual"))) -(define-key menu-bar-search-documentation-menu [emacs-terminology] - `(menu-item ,(purecopy "Emacs Terminology") search-emacs-glossary - :help ,(purecopy "Display the Glossary section of the Emacs manual"))) - -(defvar menu-bar-manuals-menu (make-sparse-keymap "More Manuals")) - -(define-key menu-bar-manuals-menu [man] - `(menu-item ,(purecopy "Read Man Page...") manual-entry - :help ,(purecopy "Man-page docs for external commands and libraries"))) -(define-key menu-bar-manuals-menu [sep2] - menu-bar-separator) -(define-key menu-bar-manuals-menu [order-emacs-manuals] - `(menu-item ,(purecopy "Ordering Manuals") view-order-manuals - :help ,(purecopy "How to order manuals from the Free Software Foundation"))) -(define-key menu-bar-manuals-menu [lookup-subject-in-all-manuals] - `(menu-item ,(purecopy "Lookup Subject in all Manuals...") info-apropos - :help ,(purecopy "Find description of a subject in all installed manuals"))) -(define-key menu-bar-manuals-menu [other-manuals] - `(menu-item ,(purecopy "All Other Manuals (Info)") Info-directory - :help ,(purecopy "Read any of the installed manuals"))) -(define-key menu-bar-manuals-menu [emacs-lisp-reference] - `(menu-item ,(purecopy "Emacs Lisp Reference") menu-bar-read-lispref - :help ,(purecopy "Read the Emacs Lisp Reference manual"))) -(define-key menu-bar-manuals-menu [emacs-lisp-intro] - `(menu-item ,(purecopy "Introduction to Emacs Lisp") menu-bar-read-lispintro - :help ,(purecopy "Read the Introduction to Emacs Lisp Programming"))) - -(define-key menu-bar-help-menu [about-gnu-project] - `(menu-item ,(purecopy "About GNU") describe-gnu-project - :help ,(purecopy "About the GNU System, GNU Project, and GNU/Linux"))) -(define-key menu-bar-help-menu [about-emacs] - `(menu-item ,(purecopy "About Emacs") about-emacs - :help ,(purecopy "Display version number, copyright info, and basic help"))) -(define-key menu-bar-help-menu [sep4] - menu-bar-separator) -(define-key menu-bar-help-menu [describe-no-warranty] - `(menu-item ,(purecopy "(Non)Warranty") describe-no-warranty - :help ,(purecopy "Explain that Emacs has NO WARRANTY"))) -(define-key menu-bar-help-menu [describe-copying] - `(menu-item ,(purecopy "Copying Conditions") describe-copying - :help ,(purecopy "Show the Emacs license (GPL)"))) -(define-key menu-bar-help-menu [getting-new-versions] - `(menu-item ,(purecopy "Getting New Versions") describe-distribution - :help ,(purecopy "How to get the latest version of Emacs"))) +(defvar menu-bar-search-documentation-menu + (let ((menu (make-sparse-keymap "Search Documentation"))) + + (define-key menu [search-documentation-strings] + `(menu-item ,(purecopy "Search Documentation Strings...") apropos-documentation + :help + ,(purecopy "Find functions and variables whose doc strings match a regexp"))) + (define-key menu [find-any-object-by-name] + `(menu-item ,(purecopy "Find Any Object by Name...") apropos + :help ,(purecopy "Find symbols of any kind whose names match a regexp"))) + (define-key menu [find-option-by-value] + `(menu-item ,(purecopy "Find Options by Value...") apropos-value + :help ,(purecopy "Find variables whose values match a regexp"))) + (define-key menu [find-options-by-name] + `(menu-item ,(purecopy "Find Options by Name...") apropos-variable + :help ,(purecopy "Find variables whose names match a regexp"))) + (define-key menu [find-commands-by-name] + `(menu-item ,(purecopy "Find Commands by Name...") apropos-command + :help ,(purecopy "Find commands whose names match a regexp"))) + (define-key menu [sep1] + menu-bar-separator) + (define-key menu [lookup-command-in-manual] + `(menu-item ,(purecopy "Look Up Command in User Manual...") Info-goto-emacs-command-node + :help ,(purecopy "Display manual section that describes a command"))) + (define-key menu [lookup-key-in-manual] + `(menu-item ,(purecopy "Look Up Key in User Manual...") Info-goto-emacs-key-command-node + :help ,(purecopy "Display manual section that describes a key"))) + (define-key menu [lookup-subject-in-elisp-manual] + `(menu-item ,(purecopy "Look Up Subject in ELisp Manual...") elisp-index-search + :help ,(purecopy "Find description of a subject in Emacs Lisp manual"))) + (define-key menu [lookup-subject-in-emacs-manual] + `(menu-item ,(purecopy "Look Up Subject in User Manual...") emacs-index-search + :help ,(purecopy "Find description of a subject in Emacs User manual"))) + (define-key menu [emacs-terminology] + `(menu-item ,(purecopy "Emacs Terminology") search-emacs-glossary + :help ,(purecopy "Display the Glossary section of the Emacs manual"))) + menu)) + +(defvar menu-bar-manuals-menu + (let ((menu (make-sparse-keymap "More Manuals"))) + + (define-key menu [man] + `(menu-item ,(purecopy "Read Man Page...") manual-entry + :help ,(purecopy "Man-page docs for external commands and libraries"))) + (define-key menu [sep2] + menu-bar-separator) + (define-key menu [order-emacs-manuals] + `(menu-item ,(purecopy "Ordering Manuals") view-order-manuals + :help ,(purecopy "How to order manuals from the Free Software Foundation"))) + (define-key menu [lookup-subject-in-all-manuals] + `(menu-item ,(purecopy "Lookup Subject in all Manuals...") info-apropos + :help ,(purecopy "Find description of a subject in all installed manuals"))) + (define-key menu [other-manuals] + `(menu-item ,(purecopy "All Other Manuals (Info)") Info-directory + :help ,(purecopy "Read any of the installed manuals"))) + (define-key menu [emacs-lisp-reference] + `(menu-item ,(purecopy "Emacs Lisp Reference") menu-bar-read-lispref + :help ,(purecopy "Read the Emacs Lisp Reference manual"))) + (define-key menu [emacs-lisp-intro] + `(menu-item ,(purecopy "Introduction to Emacs Lisp") menu-bar-read-lispintro + :help ,(purecopy "Read the Introduction to Emacs Lisp Programming"))) + menu)) + (defun menu-bar-help-extra-packages () "Display help about some additional packages available for Emacs." (interactive) @@ -1686,60 +1702,101 @@ key, a click, or a menu-item"))) (view-file (expand-file-name "MORE.STUFF" data-directory)) (goto-address-mode 1))) -(define-key menu-bar-help-menu [sep2] - menu-bar-separator) -(define-key menu-bar-help-menu [external-packages] - `(menu-item ,(purecopy "Finding Extra Packages") menu-bar-help-extra-packages - :help ,(purecopy "Lisp packages distributed separately for use in Emacs"))) -(define-key menu-bar-help-menu [find-emacs-packages] - `(menu-item ,(purecopy "Search Built-in Packages") finder-by-keyword - :help ,(purecopy "Find built-in packages and features by keyword"))) -(define-key menu-bar-help-menu [more-manuals] - `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu)) -(define-key menu-bar-help-menu [emacs-manual] - `(menu-item ,(purecopy "Read the Emacs Manual") info-emacs-manual - :help ,(purecopy "Full documentation of Emacs features"))) -(define-key menu-bar-help-menu [describe] - `(menu-item ,(purecopy "Describe") ,menu-bar-describe-menu)) -(define-key menu-bar-help-menu [search-documentation] - `(menu-item ,(purecopy "Search Documentation") ,menu-bar-search-documentation-menu)) -(define-key menu-bar-help-menu [sep1] - menu-bar-separator) -(define-key menu-bar-help-menu [emacs-psychotherapist] - `(menu-item ,(purecopy "Emacs Psychotherapist") doctor - :help ,(purecopy "Our doctor will help you feel better"))) -(define-key menu-bar-help-menu [send-emacs-bug-report] - `(menu-item ,(purecopy "Send Bug Report...") report-emacs-bug - :help ,(purecopy "Send e-mail to Emacs maintainers"))) -(define-key menu-bar-help-menu [emacs-known-problems] - `(menu-item ,(purecopy "Emacs Known Problems") view-emacs-problems - :help ,(purecopy "Read about known problems with Emacs"))) -(define-key menu-bar-help-menu [emacs-news] - `(menu-item ,(purecopy "Emacs News") view-emacs-news - :help ,(purecopy "New features of this version"))) -(define-key menu-bar-help-menu [emacs-faq] - `(menu-item ,(purecopy "Emacs FAQ") view-emacs-FAQ - :help ,(purecopy "Frequently asked (and answered) questions about Emacs"))) (defun help-with-tutorial-spec-language () "Use the Emacs tutorial, specifying which language you want." (interactive) (help-with-tutorial t)) -(define-key menu-bar-help-menu [emacs-tutorial-language-specific] - `(menu-item ,(purecopy "Emacs Tutorial (choose language)...") - help-with-tutorial-spec-language - :help ,(purecopy "Learn how to use Emacs (choose a language)"))) -(define-key menu-bar-help-menu [emacs-tutorial] - `(menu-item ,(purecopy "Emacs Tutorial") help-with-tutorial - :help ,(purecopy "Learn how to use Emacs"))) - -;; In OS X it's in the app menu already. -;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu. -(and (featurep 'ns) - (not (eq system-type 'darwin)) - (define-key menu-bar-help-menu [info-panel] - `(menu-item ,(purecopy "About Emacs...") ns-do-emacs-info-panel))) +(defvar menu-bar-help-menu + (let ((menu (make-sparse-keymap "Help"))) + (define-key menu [about-gnu-project] + `(menu-item ,(purecopy "About GNU") describe-gnu-project + :help ,(purecopy "About the GNU System, GNU Project, and GNU/Linux"))) + (define-key menu [about-emacs] + `(menu-item ,(purecopy "About Emacs") about-emacs + :help ,(purecopy "Display version number, copyright info, and basic help"))) + (define-key menu [sep4] + menu-bar-separator) + (define-key menu [describe-no-warranty] + `(menu-item ,(purecopy "(Non)Warranty") describe-no-warranty + :help ,(purecopy "Explain that Emacs has NO WARRANTY"))) + (define-key menu [describe-copying] + `(menu-item ,(purecopy "Copying Conditions") describe-copying + :help ,(purecopy "Show the Emacs license (GPL)"))) + (define-key menu [getting-new-versions] + `(menu-item ,(purecopy "Getting New Versions") describe-distribution + :help ,(purecopy "How to get the latest version of Emacs"))) + (define-key menu [sep2] + menu-bar-separator) + (define-key menu [external-packages] + `(menu-item ,(purecopy "Finding Extra Packages") menu-bar-help-extra-packages + :help ,(purecopy "Lisp packages distributed separately for use in Emacs"))) + (define-key menu [find-emacs-packages] + `(menu-item ,(purecopy "Search Built-in Packages") finder-by-keyword + :help ,(purecopy "Find built-in packages and features by keyword"))) + (define-key menu [more-manuals] + `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu)) + (define-key menu [emacs-manual] + `(menu-item ,(purecopy "Read the Emacs Manual") info-emacs-manual + :help ,(purecopy "Full documentation of Emacs features"))) + (define-key menu [describe] + `(menu-item ,(purecopy "Describe") ,menu-bar-describe-menu)) + (define-key menu [search-documentation] + `(menu-item ,(purecopy "Search Documentation") ,menu-bar-search-documentation-menu)) + (define-key menu [sep1] + menu-bar-separator) + (define-key menu [emacs-psychotherapist] + `(menu-item ,(purecopy "Emacs Psychotherapist") doctor + :help ,(purecopy "Our doctor will help you feel better"))) + (define-key menu [send-emacs-bug-report] + `(menu-item ,(purecopy "Send Bug Report...") report-emacs-bug + :help ,(purecopy "Send e-mail to Emacs maintainers"))) + (define-key menu [emacs-known-problems] + `(menu-item ,(purecopy "Emacs Known Problems") view-emacs-problems + :help ,(purecopy "Read about known problems with Emacs"))) + (define-key menu [emacs-news] + `(menu-item ,(purecopy "Emacs News") view-emacs-news + :help ,(purecopy "New features of this version"))) + (define-key menu [emacs-faq] + `(menu-item ,(purecopy "Emacs FAQ") view-emacs-FAQ + :help ,(purecopy "Frequently asked (and answered) questions about Emacs"))) + + (define-key menu [emacs-tutorial-language-specific] + `(menu-item ,(purecopy "Emacs Tutorial (choose language)...") + help-with-tutorial-spec-language + :help ,(purecopy "Learn how to use Emacs (choose a language)"))) + (define-key menu [emacs-tutorial] + `(menu-item ,(purecopy "Emacs Tutorial") help-with-tutorial + :help ,(purecopy "Learn how to use Emacs"))) + + ;; In OS X it's in the app menu already. + ;; FIXME? There already is an "About Emacs" (sans ...) entry in the Help menu. + (and (featurep 'ns) + (not (eq system-type 'darwin)) + (define-key menu [info-panel] + `(menu-item ,(purecopy "About Emacs...") ns-do-emacs-info-panel))) + menu)) + +(define-key global-map [menu-bar tools] + (cons (purecopy "Tools") menu-bar-tools-menu)) +(define-key global-map [menu-bar buffer] + (cons (purecopy "Buffers") global-buffers-menu-map)) +(define-key global-map [menu-bar options] + (cons (purecopy "Options") menu-bar-options-menu)) +(define-key global-map [menu-bar edit] + (cons (purecopy "Edit") menu-bar-edit-menu)) +(define-key global-map [menu-bar file] + (cons (purecopy "File") menu-bar-file-menu)) + +;; Put "Help" menu at the end, or Info at the front. +;; If running under GNUstep, "Help" is moved and renamed "Info" (see below). +(if (and (featurep 'ns) + (not (eq system-type 'darwin))) + (define-key global-map [menu-bar help-menu] + (cons (purecopy "Info") menu-bar-help-menu)) + (define-key-after global-map [menu-bar help-menu] + (cons (purecopy "Help") menu-bar-help-menu))) (defun menu-bar-menu-frame-live-and-visible-p () "Return non-nil if the menu frame is alive and visible. diff --git a/lisp/mouse.el b/lisp/mouse.el index c572263f3b..87f9be6bf5 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -201,9 +201,9 @@ items `Turn Off' and `Help'." newmap)) (defun mouse-menu-non-singleton (menubar) - "Given menu keymap, -if it defines exactly one submenu, return just that submenu. -Otherwise return the whole menu." + "Return menu keybar MENUBAR, or a lone submenu inside it. +If MENUBAR defines exactly one submenu, return just that submenu. +Otherwise, return MENUBAR." (if menubar (let (submap) (map-keymap @@ -1729,6 +1729,8 @@ a large number if you prefer a mixed multitude. The default is 4." ("Outline" . "Text") ("\\(HT\\|SG\\|X\\|XHT\\)ML" . "SGML") ("log\\|diff\\|vc\\|cvs\\|Annotate" . "Version Control") ; "Change Management"? + ("Threads\\|Memory\\|Disassembly\\|Breakpoints\\|Frames\\|Locals\\|Registers\\|Inferior I/O\\|Debugger" + . "GDB") ("Lisp" . "Lisp"))) "How to group various major modes together in \\[mouse-buffer-menu]. Each element has the form (REGEXP . GROUPNAME). diff --git a/lisp/msb.el b/lisp/msb.el index fb9de914ab..cbc953da98 100644 --- a/lisp/msb.el +++ b/lisp/msb.el @@ -399,8 +399,6 @@ Optional second argument MAXBUF is completely ignored." (format "%s%s %s" modified read-only name))) -(eval-when-compile (require 'dired)) - ;; `dired' can be called with a list of the form (directory file1 file2 ...) ;; which causes `dired-directory' to be in the same form. (defun msb--dired-directory () @@ -1114,7 +1112,8 @@ variable `msb-menu-cond'." (list (frame-parameter frame 'name) (frame-parameter frame 'name) (cons nil nil)) - 'menu-bar-select-frame)) + `(lambda () + (interactive) (menu-bar-select-frame ,frame)))) frames))))) (setcdr global-buffers-menu-map (if (and buffers-menu frames-menu) diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 43215003ef..05c7af2a8c 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -506,13 +506,14 @@ well formed." ;;; D-Bus registered names. -(defun dbus-list-activatable-names () +(defun dbus-list-activatable-names (&optional bus) "Return the D-Bus service names which can be activated as list. -The result is a list of strings, which is `nil' when there are no -activatable service names at all." +If BUS is left nil, `:system' is assumed. The result is a list +of strings, which is `nil' when there are no activatable service +names at all." (dbus-ignore-errors (dbus-call-method - :system dbus-service-dbus + (or bus :system) dbus-service-dbus dbus-path-dbus dbus-interface-dbus "ListActivatableNames"))) (defun dbus-list-names (bus) diff --git a/lisp/net/dns.el b/lisp/net/dns.el index 77a194ec43..3c1bd54acf 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -252,8 +252,8 @@ If TCP-P, the first two bytes of the package with be the length field." (nreverse spec)))) (defun dns-read-int32 () - ;; Full 32 bit Integers can't be handled by Emacs. If we use - ;; floats, it works. + ;; Full 32 bit Integers can't be handled by 32-bit Emacsen. If we + ;; use floats, it works. (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0) (dns-read-bytes 3)))) diff --git a/lisp/net/net-utils.el b/lisp/net/net-utils.el index 3c4588780a..d75b36051f 100644 --- a/lisp/net/net-utils.el +++ b/lisp/net/net-utils.el @@ -490,6 +490,11 @@ If your system's ping continues until interrupted, you can try setting (autoload 'comint-mode "comint" nil t) +(defvar nslookup-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\t" 'comint-dynamic-complete) + map)) + ;; Using a derived mode gives us keymaps, hooks, etc. (define-derived-mode nslookup-mode comint-mode "Nslookup" "Major mode for interacting with the nslookup program." @@ -499,8 +504,6 @@ If your system's ping continues until interrupted, you can try setting (setq comint-prompt-regexp nslookup-prompt-regexp) (setq comint-input-autoexpand t)) -(define-key nslookup-mode-map "\t" 'comint-dynamic-complete) - ;;;###autoload (defun dns-lookup-host (host) "Lookup the DNS information for HOST (name or IP address)." @@ -556,6 +559,12 @@ If your system's ping continues until interrupted, you can try setting (list host))) (pop-to-buffer buf))) +(defvar ftp-mode-map + (let ((map (make-sparse-keymap))) + ;; Occasionally useful + (define-key map "\t" 'comint-dynamic-complete) + map)) + (define-derived-mode ftp-mode comint-mode "FTP" "Major mode for interacting with the ftp program." (setq comint-prompt-regexp ftp-prompt-regexp) @@ -571,9 +580,6 @@ If your system's ping continues until interrupted, you can try setting (add-hook 'comint-output-filter-functions 'comint-watch-for-password-prompt nil t))) -;; Occasionally useful -(define-key ftp-mode-map "\t" 'comint-dynamic-complete) - (defun smbclient (host service) "Connect to SERVICE on HOST via SMB." (interactive diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el index 0e1279cd86..cd662cb178 100644 --- a/lisp/net/newst-plainview.el +++ b/lisp/net/newst-plainview.el @@ -378,6 +378,107 @@ images." ;;; Newsticker mode ;; ====================================================================== + +;; newsticker menu +(defvar newsticker-menu + (let ((map (make-sparse-keymap "Newsticker"))) + + (define-key map [newsticker-browse-url] + '("Browse URL for item at point" . newsticker-browse-url)) + (define-key map [newsticker-separator-1] + '("--")) + (define-key map [newsticker-buffer-update] + '("Update buffer" . newsticker-buffer-update)) + (define-key map [newsticker-separator-2] + '("--")) + (define-key map [newsticker-get-all-news] + '("Get news from all feeds" . newsticker-get-all-news)) + (define-key map [newsticker-get-news-at-point] + '("Get news from feed at point" . newsticker-get-news-at-point)) + (define-key map [newsticker-separator-3] + '("--")) + (define-key map [newsticker-mark-all-items-as-read] + '("Mark all items as read" . newsticker-mark-all-items-as-read)) + (define-key map [newsticker-mark-all-items-at-point-as-read] + '("Mark all items in feed at point as read" . + newsticker-mark-all-items-at-point-as-read)) + (define-key map [newsticker-mark-item-at-point-as-read] + '("Mark item at point as read" . + newsticker-mark-item-at-point-as-read)) + (define-key map [newsticker-mark-item-at-point-as-immortal] + '("Toggle immortality for item at point" . + newsticker-mark-item-at-point-as-immortal)) + (define-key map [newsticker-separator-4] + '("--")) + (define-key map [newsticker-toggle-auto-narrow-to-item] + '("Narrow to single item" . newsticker-toggle-auto-narrow-to-item)) + (define-key map [newsticker-toggle-auto-narrow-to-feed] + '("Narrow to single news feed" . newsticker-toggle-auto-narrow-to-feed)) + (define-key map [newsticker-hide-old-items] + '("Hide old items" . newsticker-hide-old-items)) + (define-key map [newsticker-show-old-items] + '("Show old items" . newsticker-show-old-items)) + (define-key map [newsticker-next-item] + '("Go to next item" . newsticker-next-item)) + (define-key map [newsticker-previous-item] + '("Go to previous item" . newsticker-previous-item)) + map)) + +(defvar newsticker-mode-map + (let ((map (make-keymap))) + (define-key map "sO" 'newsticker-show-old-items) + (define-key map "hO" 'newsticker-hide-old-items) + (define-key map "sa" 'newsticker-show-all-desc) + (define-key map "ha" 'newsticker-hide-all-desc) + (define-key map "sf" 'newsticker-show-feed-desc) + (define-key map "hf" 'newsticker-hide-feed-desc) + (define-key map "so" 'newsticker-show-old-item-desc) + (define-key map "ho" 'newsticker-hide-old-item-desc) + (define-key map "sn" 'newsticker-show-new-item-desc) + (define-key map "hn" 'newsticker-hide-new-item-desc) + (define-key map "se" 'newsticker-show-entry) + (define-key map "he" 'newsticker-hide-entry) + (define-key map "sx" 'newsticker-show-extra) + (define-key map "hx" 'newsticker-hide-extra) + + (define-key map " " 'scroll-up) + (define-key map "q" 'newsticker-close-buffer) + (define-key map "p" 'newsticker-previous-item) + (define-key map "P" 'newsticker-previous-new-item) + (define-key map "F" 'newsticker-previous-feed) + (define-key map "\t" 'newsticker-next-item) + (define-key map "n" 'newsticker-next-item) + (define-key map "N" 'newsticker-next-new-item) + (define-key map "f" 'newsticker-next-feed) + (define-key map "M" 'newsticker-mark-all-items-as-read) + (define-key map "m" + 'newsticker-mark-all-items-at-point-as-read-and-redraw) + (define-key map "o" + 'newsticker-mark-item-at-point-as-read) + (define-key map "O" + 'newsticker-mark-all-items-at-point-as-read) + (define-key map "G" 'newsticker-get-all-news) + (define-key map "g" 'newsticker-get-news-at-point) + (define-key map "u" 'newsticker-buffer-update) + (define-key map "U" 'newsticker-buffer-force-update) + (define-key map "a" 'newsticker-add-url) + + (define-key map "i" + 'newsticker-mark-item-at-point-as-immortal) + + (define-key map "xf" + 'newsticker-toggle-auto-narrow-to-feed) + (define-key map "xi" + 'newsticker-toggle-auto-narrow-to-item) + + ;; Bind menu to mouse. + (define-key map [down-mouse-3] newsticker-menu) + ;; Put menu in menu-bar. + (define-key map [menu-bar Newsticker] + (cons "Newsticker" newsticker-menu)) + + map)) + (define-derived-mode newsticker-mode fundamental-mode "NewsTicker" "Viewing news feeds in Emacs." @@ -414,114 +515,16 @@ images." (add-to-invisibility-spec 'extra)) (newsticker--buffer-set-uptodate nil)) -;; refine its mode-map -(define-key newsticker-mode-map "sO" 'newsticker-show-old-items) -(define-key newsticker-mode-map "hO" 'newsticker-hide-old-items) -(define-key newsticker-mode-map "sa" 'newsticker-show-all-desc) -(define-key newsticker-mode-map "ha" 'newsticker-hide-all-desc) -(define-key newsticker-mode-map "sf" 'newsticker-show-feed-desc) -(define-key newsticker-mode-map "hf" 'newsticker-hide-feed-desc) -(define-key newsticker-mode-map "so" 'newsticker-show-old-item-desc) -(define-key newsticker-mode-map "ho" 'newsticker-hide-old-item-desc) -(define-key newsticker-mode-map "sn" 'newsticker-show-new-item-desc) -(define-key newsticker-mode-map "hn" 'newsticker-hide-new-item-desc) -(define-key newsticker-mode-map "se" 'newsticker-show-entry) -(define-key newsticker-mode-map "he" 'newsticker-hide-entry) -(define-key newsticker-mode-map "sx" 'newsticker-show-extra) -(define-key newsticker-mode-map "hx" 'newsticker-hide-extra) - -(define-key newsticker-mode-map " " 'scroll-up) -(define-key newsticker-mode-map "q" 'newsticker-close-buffer) -(define-key newsticker-mode-map "p" 'newsticker-previous-item) -(define-key newsticker-mode-map "P" 'newsticker-previous-new-item) -(define-key newsticker-mode-map "F" 'newsticker-previous-feed) -(define-key newsticker-mode-map "\t" 'newsticker-next-item) -(define-key newsticker-mode-map "n" 'newsticker-next-item) -(define-key newsticker-mode-map "N" 'newsticker-next-new-item) -(define-key newsticker-mode-map "f" 'newsticker-next-feed) -(define-key newsticker-mode-map "M" 'newsticker-mark-all-items-as-read) -(define-key newsticker-mode-map "m" - 'newsticker-mark-all-items-at-point-as-read-and-redraw) -(define-key newsticker-mode-map "o" - 'newsticker-mark-item-at-point-as-read) -(define-key newsticker-mode-map "O" - 'newsticker-mark-all-items-at-point-as-read) -(define-key newsticker-mode-map "G" 'newsticker-get-all-news) -(define-key newsticker-mode-map "g" 'newsticker-get-news-at-point) -(define-key newsticker-mode-map "u" 'newsticker-buffer-update) -(define-key newsticker-mode-map "U" 'newsticker-buffer-force-update) -(define-key newsticker-mode-map "a" 'newsticker-add-url) - -(define-key newsticker-mode-map "i" - 'newsticker-mark-item-at-point-as-immortal) - -(define-key newsticker-mode-map "xf" - 'newsticker-toggle-auto-narrow-to-feed) -(define-key newsticker-mode-map "xi" - 'newsticker-toggle-auto-narrow-to-item) - ;; maps for the clickable portions -(defvar newsticker--url-keymap (make-sparse-keymap) +(defvar newsticker--url-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'newsticker-mouse-browse-url) + (define-key map [mouse-2] 'newsticker-mouse-browse-url) + (define-key map "\n" 'newsticker-browse-url) + (define-key map "\C-m" 'newsticker-browse-url) + (define-key map [(control return)] 'newsticker-handle-url) + map) "Key map for click-able headings in the newsticker buffer.") -(define-key newsticker--url-keymap [mouse-1] - 'newsticker-mouse-browse-url) -(define-key newsticker--url-keymap [mouse-2] - 'newsticker-mouse-browse-url) -(define-key newsticker--url-keymap "\n" - 'newsticker-browse-url) -(define-key newsticker--url-keymap "\C-m" - 'newsticker-browse-url) -(define-key newsticker--url-keymap [(control return)] - 'newsticker-handle-url) - -;; newsticker menu -(defvar newsticker-menu (make-sparse-keymap "Newsticker")) - -(define-key newsticker-menu [newsticker-browse-url] - '("Browse URL for item at point" . newsticker-browse-url)) -(define-key newsticker-menu [newsticker-separator-1] - '("--")) -(define-key newsticker-menu [newsticker-buffer-update] - '("Update buffer" . newsticker-buffer-update)) -(define-key newsticker-menu [newsticker-separator-2] - '("--")) -(define-key newsticker-menu [newsticker-get-all-news] - '("Get news from all feeds" . newsticker-get-all-news)) -(define-key newsticker-menu [newsticker-get-news-at-point] - '("Get news from feed at point" . newsticker-get-news-at-point)) -(define-key newsticker-menu [newsticker-separator-3] - '("--")) -(define-key newsticker-menu [newsticker-mark-all-items-as-read] - '("Mark all items as read" . newsticker-mark-all-items-as-read)) -(define-key newsticker-menu [newsticker-mark-all-items-at-point-as-read] - '("Mark all items in feed at point as read" . - newsticker-mark-all-items-at-point-as-read)) -(define-key newsticker-menu [newsticker-mark-item-at-point-as-read] - '("Mark item at point as read" . - newsticker-mark-item-at-point-as-read)) -(define-key newsticker-menu [newsticker-mark-item-at-point-as-immortal] - '("Toggle immortality for item at point" . - newsticker-mark-item-at-point-as-immortal)) -(define-key newsticker-menu [newsticker-separator-4] - '("--")) -(define-key newsticker-menu [newsticker-toggle-auto-narrow-to-item] - '("Narrow to single item" . newsticker-toggle-auto-narrow-to-item)) -(define-key newsticker-menu [newsticker-toggle-auto-narrow-to-feed] - '("Narrow to single news feed" . newsticker-toggle-auto-narrow-to-feed)) -(define-key newsticker-menu [newsticker-hide-old-items] - '("Hide old items" . newsticker-hide-old-items)) -(define-key newsticker-menu [newsticker-show-old-items] - '("Show old items" . newsticker-show-old-items)) -(define-key newsticker-menu [newsticker-next-item] - '("Go to next item" . newsticker-next-item)) -(define-key newsticker-menu [newsticker-previous-item] - '("Go to previous item" . newsticker-previous-item)) - -;; bind menu to mouse -(define-key newsticker-mode-map [down-mouse-3] newsticker-menu) -;; Put menu in menu-bar -(define-key newsticker-mode-map [menu-bar Newsticker] - (cons "Newsticker" newsticker-menu)) ;; ====================================================================== diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 59a7b17608..8657dc58bf 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -322,6 +322,16 @@ and the cdr part is used for encoding." :type 'function :group 'rcirc) +(defcustom rcirc-nick-completion-format "%s: " + "Format string to use in nick completions. + +The format string is only used when completing at the beginning +of a line. The string is passed as the first argument to +`format' with the nickname as the second argument." + :version "24.1" + :type 'string + :group 'rcirc) + (defvar rcirc-nick nil) (defvar rcirc-prompt-start-marker nil) @@ -554,13 +564,13 @@ last ping." (mapc (lambda (process) (with-rcirc-process-buffer process (when (not rcirc-connecting) - (rcirc-send-string process - (format "PRIVMSG %s :\C-aKEEPALIVE %f\C-a" - rcirc-nick - (if (featurep 'xemacs) - (time-to-seconds - (current-time)) - (float-time))))))) + (rcirc-send-ctcp process + rcirc-nick + (format "KEEPALIVE %f" + (if (featurep 'xemacs) + (time-to-seconds + (current-time)) + (float-time))))))) (rcirc-process-list)) ;; no processes, clean up timer (cancel-timer rcirc-keepalive-timer) @@ -704,6 +714,14 @@ Function is called with PROCESS, COMMAND, SENDER, ARGS and LINE.") (rcirc-debug process string) (process-send-string process string))) +(defun rcirc-send-privmsg (process target string) + (rcirc-send-string process (format "PRIVMSG %s :%s" target string))) + +(defun rcirc-send-ctcp (process target request &optional args) + (let ((args (if args (concat " " args) ""))) + (rcirc-send-privmsg process target + (format "\C-a%s%s\C-a" request args)))) + (defun rcirc-buffer-process (&optional buffer) "Return the process associated with channel BUFFER. With no argument or nil as argument, use the current buffer." @@ -827,11 +845,11 @@ IRC command completion is performed only if '/' is the first input char." (when completion (delete-region rcirc-completion-start (point)) (insert - (concat completion - (cond - ((= (aref completion 0) ?/) " ") - ((= rcirc-completion-start rcirc-prompt-end-marker) ": ") - (t ""))))))) + (cond + ((= (aref completion 0) ?/) (concat completion " ")) + ((= rcirc-completion-start rcirc-prompt-end-marker) + (format rcirc-nick-completion-format completion)) + (t completion)))))) (defun set-rcirc-decode-coding-system (coding-system) "Set the decode coding system used in this channel." @@ -843,41 +861,43 @@ IRC command completion is performed only if '/' is the first input char." (interactive "zCoding system for outgoing messages: ") (setq rcirc-encode-coding-system coding-system)) -(defvar rcirc-mode-map (make-sparse-keymap) +(defvar rcirc-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'rcirc-send-input) + (define-key map (kbd "M-p") 'rcirc-insert-prev-input) + (define-key map (kbd "M-n") 'rcirc-insert-next-input) + (define-key map (kbd "TAB") 'rcirc-complete) + (define-key map (kbd "C-c C-b") 'rcirc-browse-url) + (define-key map (kbd "C-c C-c") 'rcirc-edit-multiline) + (define-key map (kbd "C-c C-j") 'rcirc-cmd-join) + (define-key map (kbd "C-c C-k") 'rcirc-cmd-kick) + (define-key map (kbd "C-c C-l") 'rcirc-toggle-low-priority) + (define-key map (kbd "C-c C-d") 'rcirc-cmd-mode) + (define-key map (kbd "C-c C-m") 'rcirc-cmd-msg) + (define-key map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename + (define-key map (kbd "C-c C-o") 'rcirc-omit-mode) + (define-key map (kbd "M-o") 'rcirc-omit-mode) + (define-key map (kbd "C-c C-p") 'rcirc-cmd-part) + (define-key map (kbd "C-c C-q") 'rcirc-cmd-query) + (define-key map (kbd "C-c C-t") 'rcirc-cmd-topic) + (define-key map (kbd "C-c C-n") 'rcirc-cmd-names) + (define-key map (kbd "C-c C-w") 'rcirc-cmd-whois) + (define-key map (kbd "C-c C-x") 'rcirc-cmd-quit) + (define-key map (kbd "C-c TAB") ; C-i + 'rcirc-toggle-ignore-buffer-activity) + (define-key map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer) + (define-key map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line) + map) "Keymap for rcirc mode.") -(define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input) -(define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input) -(define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input) -(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete) -(define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url) -(define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline) -(define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join) -(define-key rcirc-mode-map (kbd "C-c C-k") 'rcirc-cmd-kick) -(define-key rcirc-mode-map (kbd "C-c C-l") 'rcirc-toggle-low-priority) -(define-key rcirc-mode-map (kbd "C-c C-d") 'rcirc-cmd-mode) -(define-key rcirc-mode-map (kbd "C-c C-m") 'rcirc-cmd-msg) -(define-key rcirc-mode-map (kbd "C-c C-r") 'rcirc-cmd-nick) ; rename -(define-key rcirc-mode-map (kbd "C-c C-o") 'rcirc-omit-mode) -(define-key rcirc-mode-map (kbd "M-o") 'rcirc-omit-mode) -(define-key rcirc-mode-map (kbd "C-c C-p") 'rcirc-cmd-part) -(define-key rcirc-mode-map (kbd "C-c C-q") 'rcirc-cmd-query) -(define-key rcirc-mode-map (kbd "C-c C-t") 'rcirc-cmd-topic) -(define-key rcirc-mode-map (kbd "C-c C-n") 'rcirc-cmd-names) -(define-key rcirc-mode-map (kbd "C-c C-w") 'rcirc-cmd-whois) -(define-key rcirc-mode-map (kbd "C-c C-x") 'rcirc-cmd-quit) -(define-key rcirc-mode-map (kbd "C-c TAB") ; C-i - 'rcirc-toggle-ignore-buffer-activity) -(define-key rcirc-mode-map (kbd "C-c C-s") 'rcirc-switch-to-server-buffer) -(define-key rcirc-mode-map (kbd "C-c C-a") 'rcirc-jump-to-first-unread-line) - -(defvar rcirc-browse-url-map (make-sparse-keymap) +(defvar rcirc-browse-url-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'rcirc-browse-url-at-point) + (define-key map (kbd "<mouse-2>") 'rcirc-browse-url-at-mouse) + (define-key map [follow-link] 'mouse-face) + map) "Keymap used for browsing URLs in `rcirc-mode'.") -(define-key rcirc-browse-url-map (kbd "RET") 'rcirc-browse-url-at-point) -(define-key rcirc-browse-url-map (kbd "<mouse-2>") 'rcirc-browse-url-at-mouse) -(define-key rcirc-browse-url-map [follow-link] 'mouse-face) - (defvar rcirc-short-buffer-name nil "Generated abbreviation to use to indicate buffer activity.") @@ -1025,6 +1045,17 @@ If ALL is non-nil, update prompts in all IRC buffers." (or (eq (aref target 0) ?#) (eq (aref target 0) ?&)))) +(defcustom rcirc-log-directory "~/.emacs.d/rcirc-log" + "Directory to keep IRC logfiles." + :type 'directory + :group 'rcirc) + +(defcustom rcirc-log-flag nil + "Non-nil means log IRC activity to disk. +Logfiles are kept in `rcirc-log-directory'." + :type 'boolean + :group 'rcirc) + (defun rcirc-kill-buffer-hook () "Part the channel when killing an rcirc buffer." (when (eq major-mode 'rcirc-mode) @@ -1187,16 +1218,14 @@ Create the buffer if it doesn't exist." (and (> pos 0) (goto-char pos)) (message "Type C-c C-c to return text to %s, or C-c C-k to cancel" parent)))) -(defvar rcirc-multiline-minor-mode-map (make-sparse-keymap) +(defvar rcirc-multiline-minor-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") 'rcirc-multiline-minor-submit) + (define-key map (kbd "C-x C-s") 'rcirc-multiline-minor-submit) + (define-key map (kbd "C-c C-k") 'rcirc-multiline-minor-cancel) + (define-key map (kbd "ESC ESC ESC") 'rcirc-multiline-minor-cancel) + map) "Keymap for multiline mode in rcirc.") -(define-key rcirc-multiline-minor-mode-map - (kbd "C-c C-c") 'rcirc-multiline-minor-submit) -(define-key rcirc-multiline-minor-mode-map - (kbd "C-x C-s") 'rcirc-multiline-minor-submit) -(define-key rcirc-multiline-minor-mode-map - (kbd "C-c C-k") 'rcirc-multiline-minor-cancel) -(define-key rcirc-multiline-minor-mode-map - (kbd "ESC ESC ESC") 'rcirc-multiline-minor-cancel) (define-minor-mode rcirc-multiline-minor-mode "Minor mode for editing multiple lines in rcirc." @@ -1355,17 +1384,6 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (defvar rcirc-last-sender nil) (make-variable-buffer-local 'rcirc-last-sender) -(defcustom rcirc-log-directory "~/.emacs.d/rcirc-log" - "Directory to keep IRC logfiles." - :type 'directory - :group 'rcirc) - -(defcustom rcirc-log-flag nil - "Non-nil means log IRC activity to disk. -Logfiles are kept in `rcirc-log-directory'." - :type 'boolean - :group 'rcirc) - (defcustom rcirc-omit-threshold 100 "Number of lines since last activity from a nick before `rcirc-omit-responses' are omitted." :type 'integer @@ -1724,12 +1742,13 @@ This function does not alter the INPUT string." (mapconcat 'identity sorted sep))) ;;; activity tracking -(defvar rcirc-track-minor-mode-map (make-sparse-keymap) +(defvar rcirc-track-minor-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-@") 'rcirc-next-active-buffer) + (define-key map (kbd "C-c C-SPC") 'rcirc-next-active-buffer) + map) "Keymap for rcirc track minor mode.") -(define-key rcirc-track-minor-mode-map (kbd "C-c C-@") 'rcirc-next-active-buffer) -(define-key rcirc-track-minor-mode-map (kbd "C-c C-SPC") 'rcirc-next-active-buffer) - ;;;###autoload (define-minor-mode rcirc-track-minor-mode "Global minor mode for tracking activity in rcirc buffers." @@ -2079,14 +2098,18 @@ activity. Only run if the buffer is not visible and (when (not existing-buffer) (rcirc-cmd-whois nick)))) -(defun-rcirc-command join (channel) - "Join CHANNEL." - (interactive "sJoin channel: ") - (let ((buffer (rcirc-get-buffer-create process - (car (split-string channel))))) - (rcirc-send-string process (concat "JOIN " channel)) +(defun-rcirc-command join (channels) + "Join CHANNELS. +CHANNELS is a comma- or space-separated string of channel names." + (interactive "sJoin channels: ") + (let* ((split-channels (split-string channels "[ ,]" t)) + (buffers (mapcar (lambda (ch) + (rcirc-get-buffer-create process ch)) + split-channels))) + (rcirc-send-string process (concat "JOIN " channels)) (when (not (eq (selected-window) (minibuffer-window))) - (switch-to-buffer buffer)))) + (dolist (b buffers) ;; order the new channel buffers in the buffer list + (switch-to-buffer b))))) ;; TODO: /part #channel reason, or consider removing #channel altogether (defun-rcirc-command part (channel) @@ -2175,17 +2198,22 @@ With a prefix arg, prompt for new topic." (defun rcirc-cmd-ctcp (args &optional process target) (if (string-match "^\\([^ ]+\\)\\s-+\\(.+\\)$" args) - (let ((target (match-string 1 args)) - (request (match-string 2 args))) - (rcirc-send-string process - (format "PRIVMSG %s \C-a%s\C-a" - target (upcase request)))) + (let* ((target (match-string 1 args)) + (request (upcase (match-string 2 args))) + (function (intern-soft (concat "rcirc-ctcp-sender-" request)))) + (if (fboundp function) ;; use special function if available + (funcall function process target request) + (rcirc-send-ctcp process target request))) (rcirc-print process (rcirc-nick process) "ERROR" nil "usage: /ctcp NICK REQUEST"))) +(defun rcirc-ctcp-sender-PING (process target request) + "Send a CTCP PING message to TARGET." + (let ((timestamp (format "%.0f" (float-time)))) + (rcirc-send-ctcp process target "PING" timestamp))) + (defun rcirc-cmd-me (args &optional process target) - (rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a" - target args))) + (rcirc-send-ctcp process target "ACTION" args)) (defun rcirc-add-or-remove (set &rest elements) (dolist (elt elements) @@ -2445,7 +2473,10 @@ keywords when no KEYWORD is given." (rcirc-elapsed-lines process sender channel))) (when (and last-activity-lines (< last-activity-lines rcirc-omit-threshold)) - (rcirc-last-line process sender channel))))) + (rcirc-last-line process sender channel)))) + ;; reset mode-line-process in case joining a channel with an + ;; already open buffer (after getting kicked e.g.) + (setq mode-line-process nil)) (rcirc-print process sender "JOIN" channel "") @@ -2579,6 +2610,20 @@ keywords when no KEYWORD is given." (setq rcirc-nick-away-alist (cons (cons nick away-message) rcirc-nick-away-alist)))))) +(defun rcirc-handler-317 (process sender args text) + "RPL_WHOISIDLE" + (let* ((nick (nth 1 args)) + (idle-secs (string-to-number (nth 2 args))) + (idle-string + (if (< idle-secs most-positive-fixnum) + (format-seconds "%yy %dd %hh %mm %z%ss" idle-secs) + "a very long time")) + (signon-time (seconds-to-time (string-to-number (nth 3 args)))) + (signon-string (format-time-string "%c" signon-time)) + (message (format "%s idle for %s, signed on %s" + nick idle-string signon-string))) + (rcirc-print process sender "317" nil message t))) + (defun rcirc-handler-332 (process sender args text) "RPL_TOPIC" (let ((buffer (or (rcirc-get-buffer process (cadr args)) @@ -2663,20 +2708,20 @@ Passwords are stored in `rcirc-authinfo' (which see)." (when (and (string-match server rcirc-server) (string-match nick rcirc-nick)) (cond ((equal method 'nickserv) - (rcirc-send-string + (rcirc-send-privmsg process - (concat "PRIVMSG " (or (cadr args) "nickserv") - " :identify " (car args)))) + (or (cadr args) "NickServ") + (concat "identify " (car args)))) ((equal method 'chanserv) - (rcirc-send-string + (rcirc-send-privmsg process - (concat - "PRIVMSG chanserv :identify " - (car args) " " (cadr args)))) + "ChanServ" + (format "identify %s %s" (car args) (cadr args)))) ((equal method 'bitlbee) - (rcirc-send-string + (rcirc-send-privmsg process - (concat "PRIVMSG &bitlbee :identify " (car args)))) + "&bitlbee" + (concat "identify " (car args)))) (t (message "No %S authentication method defined" method)))))))) diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index c893ce797e..a98e523a68 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -33,7 +33,7 @@ ;; - localname is NIL. This are reusable properties. Examples: ;; "remote-shell" identifies the POSIX shell to be called on the ;; remote host, or "perl" is the command to be called on the remote -;; host, when starting a Perl script. These properties are saved in +;; host when starting a Perl script. These properties are saved in ;; the file `tramp-persistency-file-name'. ;; ;; - localname is a string. This are temporary properties, which are diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 4dcc3d5484..3c0642c3c7 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -156,7 +156,7 @@ 'set-file-times filename time))))) ;; We currently use "[" and "]" in the filename format for IPv6 - ;; hosts of GNU Emacs. This means, that Emacs wants to expand + ;; hosts of GNU Emacs. This means that Emacs wants to expand ;; wildcards if `find-file-wildcards' is non-nil, and then barfs ;; because no expansion could be found. We detect this situation ;; and do something really awful: we have `file-expand-wildcards' diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 0f3a0cf33f..57cc54935d 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1212,14 +1212,14 @@ connection if a previous connection has died for some reason." ;; Enable auth-sorce and password-cache. (tramp-set-connection-property vec "first-password-request" t) - ;; There will be a callback of "askPassword", when a password is + ;; There will be a callback of "askPassword" when a password is ;; needed. (dbus-register-method :session dbus-service-emacs object-path tramp-gvfs-interface-mountoperation "askPassword" 'tramp-gvfs-handler-askpassword) - ;; There could be a callback of "askQuestion", when adding fingerprint. + ;; There could be a callback of "askQuestion" when adding fingerprint. (dbus-register-method :session dbus-service-emacs object-path tramp-gvfs-interface-mountoperation "askQuestion" @@ -1426,7 +1426,7 @@ They are retrieved from the hal daemon." ;;; TODO: ;; * Host name completion via smb-server or smb-network. -;; * Check, how two shares of the same SMB server can be mounted in +;; * Check how two shares of the same SMB server can be mounted in ;; parallel. ;; * Apply SDP on bluetooth devices, in order to filter out obex ;; capability. diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el index e0799e070a..3a536103c3 100644 --- a/lisp/net/tramp-imap.el +++ b/lisp/net/tramp-imap.el @@ -265,7 +265,7 @@ of `copy' and `rename'." filename newname) ;; We just make a local copy of FILENAME, and write it then to - ;; NEWNAME. This must be optimized, when both files are + ;; NEWNAME. This must be optimized when both files are ;; located on the same IMAP server. (with-temp-buffer (if (and t1 t2) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index ccc9028825..63a4c19ecc 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -66,9 +66,9 @@ files conditionalize this setup based on the TERM environment variable." :group 'tramp :type 'string) -;; ksh on OpenBSD 4.5 requires, that $PS1 contains a `#' character for +;; ksh on OpenBSD 4.5 requires that $PS1 contains a `#' character for ;; root users. It uses the `$' character for other users. In order -;; to guarantee a proper prompt, we use "#$" for the prompt. +;; to guarantee a proper prompt, we use "#$ " for the prompt. (defvar tramp-end-of-output (format @@ -482,7 +482,9 @@ tilde expansion, all directory names starting with `~' will be ignored. `Default Directories' represent the list of directories given by the command \"getconf PATH\". It is recommended to use this entry on top of this list, because these are the default -directories for POSIX compatible commands. +directories for POSIX compatible commands. On remote hosts which +do not offer the getconf command (like cygwin), the value +\"/bin:/usr/bin\" is used instead of. `Private Directories' are the settings of the $PATH environment, as given in your `~/.profile'." @@ -507,7 +509,7 @@ entry ENVVARNAME= diables the corresponding environment variable, which might have been set in the init files like ~/.profile. Special handling is applied to the PATH environment, which should -not be set here. Instead of, it should be set via `tramp-remote-path'." +not be set here. Instead, it should be set via `tramp-remote-path'." :group 'tramp :type '(repeat string)) @@ -2207,7 +2209,7 @@ The method used must be an out-of-band method." (with-parsed-tramp-file-name (if t1 filename newname) nil (if (and t1 t2) - ;; Both are Tramp files. We shall optimize it, when the + ;; Both are Tramp files. We shall optimize it when the ;; methods for filename and newname are the same. (let* ((dir-flag (file-directory-p filename)) (tmpfile (tramp-compat-make-temp-file localname dir-flag))) @@ -2403,7 +2405,7 @@ This is like `dired-recursive-delete-directory' for Tramp files." (tramp-send-command v (format "rm -rf %s" (tramp-shell-quote-argument localname)) - ;; Don't read the output, do it explicitely. + ;; Don't read the output, do it explicitly. nil t) ;; Wait for the remote system to return to us... ;; This might take a while, allow it plenty of time. @@ -3148,7 +3150,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." ;; filename does not exist (eq modes nil) it has been ;; renamed to the backup file. This case `save-buffer' ;; handles permissions. - ;; Ensure, that it is still readable. + ;; Ensure that it is still readable. (when modes (set-file-modes tmpfile @@ -3294,7 +3296,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (when (or (eq visit t) (stringp visit)) (let ((file-attr (file-attributes filename))) (set-visited-file-modtime - ;; We must pass modtime explicitely, because filename can + ;; We must pass modtime explicitly, because filename can ;; be different from (buffer-file-name), f.e. if ;; `file-precious-flag' is set. (nth 5 file-attr)) @@ -3401,7 +3403,7 @@ Fall back to normal file name handler if no Tramp handler exists." (with-parsed-tramp-file-name filename nil (cond ;; That's what we want: file names, for which checks are - ;; applied. We assume, that VC uses only `file-exists-p' and + ;; applied. We assume that VC uses only `file-exists-p' and ;; `file-readable-p' checks; otherwise we must extend the ;; list. We do not perform any action, but return nil, in ;; order to keep `vc-registered' running. @@ -4301,7 +4303,7 @@ connection if a previous connection has died for some reason." ;; it is just a prefix for the ControlPath option ;; of ssh; the real temporary file has another ;; name, and it is created and protected by ssh. - ;; It is also removed by ssh, when the connection + ;; It is also removed by ssh when the connection ;; is closed. (tmpfile (tramp-set-connection-property @@ -4655,11 +4657,12 @@ This is used internally by `tramp-file-mode-from-int'." (elt2 (memq 'tramp-own-remote-path remote-path)) (default-remote-path (when elt1 - (condition-case nil - (tramp-send-command-and-read - vec "echo \\\"`getconf PATH`\\\"") - ;; Default if "getconf" is not available. - (error + (or + (tramp-send-command-and-read + vec + "x=`getconf PATH 2>/dev/null` && echo \\\"$x\\\" || echo nil") + ;; Default if "getconf" is not available. + (progn (tramp-message vec 3 "`getconf PATH' not successful, using default value \"%s\"." @@ -4669,7 +4672,6 @@ This is used internally by `tramp-file-mode-from-int'." (when elt2 (condition-case nil (tramp-send-command-and-read vec "echo \\\"$PATH\\\"") - ;; Default if "getconf" is not available. (error (tramp-message vec 3 "$PATH not set, ignoring `tramp-own-remote-path'.") @@ -5072,7 +5074,7 @@ function cell is returned to be applied on a buffer." ;; * It makes me wonder if tramp couldn't fall back to ssh when scp ;; isn't on the remote host. (Mark A. Hershberger) ;; * Use lsh instead of ssh. (Alfred M. Szmidt) -;; * Optimize out-of-band copying, when both methods are scp-like (not +;; * Optimize out-of-band copying when both methods are scp-like (not ;; rsync). ;; * Keep a second connection open for out-of-band methods like scp or ;; rsync. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 51e9c600b0..7e1b0f5b8e 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -76,45 +76,48 @@ call, letting the SMB client use the default one." "Regexp used as prompt in smbclient.") (defconst tramp-smb-errors - ;; `regexp-opt' not possible because of first string. (mapconcat 'identity - '(;; Connection error / timeout / unknown command. - "Connection to \\S-+ failed" + `(;; Connection error / timeout / unknown command. + "Connection\\( to \\S-+\\)? failed" "Read from server failed, maybe it closed the connection" "Call timed out: server did not respond" "\\S-+: command not found" "Server doesn't support UNIX CIFS calls" - ;; Samba. - "ERRDOS" - "ERRHRD" - "ERRSRV" - "ERRbadfile" - "ERRbadpw" - "ERRfilexists" - "ERRnoaccess" - "ERRnomem" - "ERRnosuchshare" - ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), - ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003). - "NT_STATUS_ACCESS_DENIED" - "NT_STATUS_ACCOUNT_LOCKED_OUT" - "NT_STATUS_BAD_NETWORK_NAME" - "NT_STATUS_CANNOT_DELETE" - "NT_STATUS_CONNECTION_REFUSED" - "NT_STATUS_DIRECTORY_NOT_EMPTY" - "NT_STATUS_DUPLICATE_NAME" - "NT_STATUS_FILE_IS_A_DIRECTORY" - "NT_STATUS_LOGON_FAILURE" - "NT_STATUS_NETWORK_ACCESS_DENIED" - "NT_STATUS_NOT_IMPLEMENTED" - "NT_STATUS_NO_SUCH_FILE" - "NT_STATUS_OBJECT_NAME_COLLISION" - "NT_STATUS_OBJECT_NAME_INVALID" - "NT_STATUS_OBJECT_NAME_NOT_FOUND" - "NT_STATUS_SHARING_VIOLATION" - "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" - "NT_STATUS_WRONG_PASSWORD") + ,(regexp-opt + '(;; Samba. + "ERRDOS" + "ERRHRD" + "ERRSRV" + "ERRbadfile" + "ERRbadpw" + "ERRfilexists" + "ERRnoaccess" + "ERRnomem" + "ERRnosuchshare" + ;; Windows 4.0 (Windows NT), Windows 5.0 (Windows 2000), + ;; Windows 5.1 (Windows XP), Windows 5.2 (Windows Server 2003). + "NT_STATUS_ACCESS_DENIED" + "NT_STATUS_ACCOUNT_LOCKED_OUT" + "NT_STATUS_BAD_NETWORK_NAME" + "NT_STATUS_CANNOT_DELETE" + "NT_STATUS_CONNECTION_REFUSED" + "NT_STATUS_DIRECTORY_NOT_EMPTY" + "NT_STATUS_DUPLICATE_NAME" + "NT_STATUS_FILE_IS_A_DIRECTORY" + "NT_STATUS_IO_TIMEOUT" + "NT_STATUS_LOGON_FAILURE" + "NT_STATUS_NETWORK_ACCESS_DENIED" + "NT_STATUS_NOT_IMPLEMENTED" + "NT_STATUS_NO_SUCH_FILE" + "NT_STATUS_NO_SUCH_USER" + "NT_STATUS_OBJECT_NAME_COLLISION" + "NT_STATUS_OBJECT_NAME_INVALID" + "NT_STATUS_OBJECT_NAME_NOT_FOUND" + "NT_STATUS_SHARING_VIOLATION" + "NT_STATUS_TRUSTED_RELATIONSHIP_FAILURE" + "NT_STATUS_UNSUCCESSFUL" + "NT_STATUS_WRONG_PASSWORD"))) "\\|") "Regexp for possible error strings of SMB servers. Used instead of analyzing error codes of commands.") @@ -1036,17 +1039,17 @@ Result is a list of (LOCALNAME MODE SIZE MONTH DAY TIME YEAR)." ;; \s-\{2,2} - leading spaces ;; \S-\(.*\S-\)\s-* - file name, 30 chars, left bound ;; \s-+[ADHRSV]* - permissions, 7 chars, right bound -;; \s- - space delimeter +;; \s- - space delimiter ;; \s-+[0-9]+ - size, 8 chars, right bound -;; \s-\{2,2\} - space delimeter +;; \s-\{2,2\} - space delimiter ;; \w\{3,3\} - weekday -;; \s- - space delimeter +;; \s- - space delimiter ;; \w\{3,3\} - month -;; \s- - space delimeter +;; \s- - space delimiter ;; [ 12][0-9] - day -;; \s- - space delimeter +;; \s- - space delimiter ;; [0-9]\{2,2\}:[0-9]\{2,2\}:[0-9]\{2,2\} - time -;; \s- - space delimeter +;; \s- - space delimiter ;; [0-9]\{4,4\} - year ;; ;; samba/src/client.c (http://samba.org/doxygen/samba/client_8c-source.html) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 93250e3864..8584d4ddc9 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -660,12 +660,12 @@ Should always start with \"^\". Derived from `tramp-prefix-format'.") ((equal tramp-syntax 'sep) "/") ((equal tramp-syntax 'url) "://") (t (error "Wrong `tramp-syntax' defined"))) - "*String matching delimeter between method and user or host names. + "*String matching delimiter between method and user or host names. Used in `tramp-make-tramp-file-name'.") (defconst tramp-postfix-method-regexp (regexp-quote tramp-postfix-method-format) - "*Regexp matching delimeter between method and user or host names. + "*Regexp matching delimiter between method and user or host names. Derived from `tramp-postfix-method-format'.") (defconst tramp-user-regexp "[^:/ \t]+" @@ -673,12 +673,12 @@ Derived from `tramp-postfix-method-format'.") ;;;###tramp-autoload (defconst tramp-prefix-domain-format "%" - "*String matching delimeter between user and domain names.") + "*String matching delimiter between user and domain names.") ;;;###tramp-autoload (defconst tramp-prefix-domain-regexp (regexp-quote tramp-prefix-domain-format) - "*Regexp matching delimeter between user and domain names. + "*Regexp matching delimiter between user and domain names. Derived from `tramp-prefix-domain-format'.") (defconst tramp-domain-regexp "[-a-zA-Z0-9_.]+" @@ -691,12 +691,12 @@ Derived from `tramp-prefix-domain-format'.") "*Regexp matching user names with domain names.") (defconst tramp-postfix-user-format "@" - "*String matching delimeter between user and host names. + "*String matching delimiter between user and host names. Used in `tramp-make-tramp-file-name'.") (defconst tramp-postfix-user-regexp (regexp-quote tramp-postfix-user-format) - "*Regexp matching delimeter between user and host names. + "*Regexp matching delimiter between user and host names. Derived from `tramp-postfix-user-format'.") (defconst tramp-host-regexp "[a-zA-Z0-9_.-]+" @@ -740,11 +740,11 @@ Derived from `tramp-postfix-ipv6-format'.") ((equal tramp-syntax 'sep) "#") ((equal tramp-syntax 'url) ":") (t (error "Wrong `tramp-syntax' defined"))) - "*String matching delimeter between host names and port numbers.") + "*String matching delimiter between host names and port numbers.") (defconst tramp-prefix-port-regexp (regexp-quote tramp-prefix-port-format) - "*Regexp matching delimeter between host names and port numbers. + "*Regexp matching delimiter between host names and port numbers. Derived from `tramp-prefix-port-format'.") (defconst tramp-port-regexp "[0-9]+" @@ -761,12 +761,12 @@ Derived from `tramp-prefix-port-format'.") ((equal tramp-syntax 'sep) "]") ((equal tramp-syntax 'url) "") (t (error "Wrong `tramp-syntax' defined"))) - "*String matching delimeter between host names and localnames. + "*String matching delimiter between host names and localnames. Used in `tramp-make-tramp-file-name'.") (defconst tramp-postfix-host-regexp (regexp-quote tramp-postfix-host-format) - "*Regexp matching delimeter between host names and localnames. + "*Regexp matching delimiter between host names and localnames. Derived from `tramp-postfix-host-format'.") (defconst tramp-localname-regexp ".*$" @@ -1861,7 +1861,7 @@ Falls back to normal file name handler if no Tramp file name handler exists." (condition-case err (apply foreign operation args) - ;; Trace, that somebody has interrupted the operation. + ;; Trace that somebody has interrupted the operation. (quit (let (tramp-message-show-message) (tramp-message @@ -2319,7 +2319,7 @@ remote host and localname (filename on remote host)." (vector method user host localname))))) ;; This function returns all possible method completions, adding the -;; trailing method delimeter. +;; trailing method delimiter. (defun tramp-get-completion-methods (partial-method) "Returns all method completions for PARTIAL-METHOD." (mapcar @@ -2937,7 +2937,7 @@ User is always nil." (defun tramp-handle-substitute-in-file-name (filename) "Like `substitute-in-file-name' for Tramp files. \"//\" and \"/~\" substitute only in the local filename part. -If the URL Tramp syntax is chosen, \"//\" as method delimeter and \"/~\" at +If the URL Tramp syntax is chosen, \"//\" as method delimiter and \"/~\" at beginning of local filename are not substituted." ;; First, we must replace environment variables. (setq filename (tramp-replace-environment-variables filename)) diff --git a/lisp/net/xesam.el b/lisp/net/xesam.el index 16500c61b7..21a2274940 100644 --- a/lisp/net/xesam.el +++ b/lisp/net/xesam.el @@ -446,7 +446,12 @@ If there is no registered search engine at all, the function returns `nil'." ;;; Search buffers. -(define-derived-mode xesam-mode nil "Xesam" +(defvar xesam-mode-map + (let ((map (copy-keymap special-mode-map))) + (set-keymap-parent xesam-mode-map widget-keymap) + map)) + +(define-derived-mode xesam-mode special-mode "Xesam" "Major mode for presenting search results of a Xesam search. In this mode, widgets represent the search results. @@ -455,12 +460,6 @@ Turning on Xesam mode runs the normal hook `xesam-mode-hook'. It can be used to set `xesam-notify-function', which must a search engine specific, widget :notify function to visualize xesam:url." (set (make-local-variable 'xesam-notify-function) nil) - - ;; Keymap. - (setq xesam-mode-map (copy-keymap special-mode-map)) - (set-keymap-parent xesam-mode-map widget-keymap) - (define-key xesam-mode-map "z" 'kill-this-buffer) - ;; Maybe we implement something useful, later on. (set (make-local-variable 'revert-buffer-function) 'ignore) ;; `xesam-engine', `xesam-search', `xesam-type', `xesam-query', and diff --git a/lisp/emulation/pc-mode.el b/lisp/obsolete/pc-mode.el index c0ed1925b4..192392d382 100644 --- a/lisp/emulation/pc-mode.el +++ b/lisp/obsolete/pc-mode.el @@ -4,6 +4,7 @@ ;; Maintainer: FSF ;; Keywords: emulations +;; Obsolete-since: 24.1 ;; This file is part of GNU Emacs. diff --git a/lisp/obsolete/pc-select.el b/lisp/obsolete/pc-select.el new file mode 100644 index 0000000000..9a5f9e9d9d --- /dev/null +++ b/lisp/obsolete/pc-select.el @@ -0,0 +1,417 @@ +;;; pc-select.el --- emulate mark, cut, copy and paste from Motif +;;; (or MAC GUI or MS-windoze (bah)) look-and-feel +;;; including key bindings. + +;; Copyright (C) 1995-1997, 2000-2011 Free Software Foundation, Inc. + +;; Author: Michael Staats <[email protected]> +;; Keywords: convenience emulations +;; Created: 26 Sep 1995 +;; Obsolete-since: 24.1 + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This package emulates the mark, copy, cut and paste look-and-feel of motif +;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows). +;; It modifies the keybindings of the cursor keys and the next, prior, +;; home and end keys. They will modify mark-active. +;; You can still get the old behavior of cursor moving with the +;; control sequences C-f, C-b, etc. +;; This package uses transient-mark-mode and +;; delete-selection-mode. +;; +;; In addition to that all key-bindings from the pc-mode are +;; done here too (as suggested by RMS). +;; +;; As I found out after I finished the first version, s-region.el tries +;; to do the same.... But my code is a little more complete and using +;; delete-selection-mode is very important for the look-and-feel. +;; Pete Forman <[email protected]> provided some motif +;; compliant keybindings which I added. I had to modify them a little +;; to add the -mark and -nomark functionality of cursor moving. +;; +;; Credits: +;; Many thanks to all who made comments. +;; Thanks to RMS and Ralf Muschall <[email protected]> for criticism. +;; Kevin Cutts <[email protected]> added the beginning-of-buffer +;; and end-of-buffer functions which I modified a little. +;; David Biesack <[email protected]> suggested some more cleanup. +;; Thanks to Pete Forman <[email protected]> +;; for additional motif keybindings. +;; Thanks to [email protected] (Johan Vromans) for a bug report +;; concerning setting of this-command. +;; Dan Nicolaescu <[email protected]> suggested suppressing the +;; scroll-up/scroll-down error. +;; Eli Barzilay ([email protected]) suggested the sexps functions and +;; keybindings. +;; +;; Ok, some details about the idea of PC Selection mode: +;; +;; o The standard keys for moving around (right, left, up, down, home, end, +;; prior, next, called "move-keys" from now on) will always de-activate +;; the mark. +;; o If you press "Shift" together with the "move-keys", the region +;; you pass along is activated +;; o You have the copy, cut and paste functions (as in many other programs) +;; which will operate on the active region +;; It was not possible to bind them to C-v, C-x and C-c for obvious +;; emacs reasons. +;; They will be bound according to the "old" behavior to S-delete (cut), +;; S-insert (paste) and C-insert (copy). These keys do the same in many +;; other programs. +;; + +;;; Code: + +;; Customization: +(defgroup pc-select nil + "Emulate pc bindings." + :prefix "pc-select" + :group 'emulations) + +(define-obsolete-variable-alias 'pc-select-override-scroll-error + 'scroll-error-top-bottom + "24.1") +(defcustom pc-select-override-scroll-error t + "Non-nil means don't generate error on scrolling past edge of buffer. +This variable applies in PC Selection mode only. +The scroll commands normally generate an error if you try to scroll +past the top or bottom of the buffer. This is annoying when selecting +text with these commands. If you set this variable to non-nil, these +errors are suppressed." + :type 'boolean + :group 'pc-select) + +(defcustom pc-select-selection-keys-only nil + "Non-nil means only bind the basic selection keys when started. +Other keys that emulate pc-behavior will be untouched. +This gives mostly Emacs-like behavior with only the selection keys enabled." + :type 'boolean + :group 'pc-select) + +(defcustom pc-select-meta-moves-sexps nil + "Non-nil means move sexp-wise with Meta key, otherwise move word-wise." + :type 'boolean + :group 'pc-select) + +(defcustom pc-selection-mode-hook nil + "The hook to run when PC Selection mode is toggled." + :type 'hook + :group 'pc-select) + +(defvar pc-select-saved-settings-alist nil + "The values of the variables before PC Selection mode was toggled on. +When PC Selection mode is toggled on, it sets quite a few variables +for its own purposes. This alist holds the original values of the +variables PC Selection mode had set, so that these variables can be +restored to their original values when PC Selection mode is toggled off.") + +(defvar pc-select-map nil + "The keymap used as the global map when PC Selection mode is on." ) + +(defvar pc-select-saved-global-map nil + "The global map that was in effect when PC Selection mode was toggled on.") + +(defvar pc-select-key-bindings-alist nil + "This alist holds all the key bindings PC Selection mode sets.") + +(defvar pc-select-default-key-bindings nil + "These key bindings always get set by PC Selection mode.") + +(defvar pc-select-extra-key-bindings + ;; The following keybindings are for standard ISO keyboards + ;; as they are used with IBM compatible PCs, IBM RS/6000, + ;; MACs, many X-Stations and probably more. + '(;; Commented out since it's been standard at least since Emacs-21. + ;;([S-insert] . yank) + ;;([C-insert] . copy-region-as-kill) + ;;([S-delete] . kill-region) + + ;; The following bindings are useful on Sun Type 3 keyboards + ;; They implement the Get-Delete-Put (copy-cut-paste) + ;; functions from sunview on the L6, L8 and L10 keys + ;; Sam Steingold <[email protected]> says that f16 is copy and f18 is paste. + ([f16] . copy-region-as-kill) + ([f18] . yank) + ([f20] . kill-region) + + ;; The following bindings are from Pete Forman. + ([f6] . other-window) ; KNextPane F6 + ([C-delete] . kill-line) ; KEraseEndLine cDel + ("\M-\d" . undo) ; KUndo aBS + + ;; The following binding is taken from pc-mode.el + ;; as suggested by RMS. + ;; I only used the one that is not covered above. + ([C-M-delete] . kill-sexp) + ;; Next line proposed by Eli Barzilay + ([C-escape] . electric-buffer-list)) + "Key bindings to set only if `pc-select-selection-keys-only' is nil.") + +(defvar pc-select-meta-moves-sexps-key-bindings + '((([M-right] . forward-sexp) + ([M-left] . backward-sexp)) + (([M-right] . forward-word) + ([M-left] . backward-word))) + "The list of key bindings controlled by `pc-select-meta-moves-sexp'. +The bindings in the car of this list get installed if +`pc-select-meta-moves-sexp' is t, the bindings in the cadr of this +list get installed otherwise.") + +;; This is for tty. We don't turn on normal-erase-is-backspace, +;; but bind keys as pc-selection-mode did before +;; normal-erase-is-backspace was invented, to keep us back +;; compatible. +(defvar pc-select-tty-key-bindings + '(([delete] . delete-char) ; KDelete Del + ([C-backspace] . backward-kill-word)) + "The list of key bindings controlled by `pc-select-selection-keys-only'. +These key bindings get installed when running in a tty, but only if +`pc-select-selection-keys-only' is nil.") + +(defvar pc-select-old-M-delete-binding nil + "Holds the old mapping of [M-delete] in the `function-key-map'. +This variable holds the value associated with [M-delete] in the +`function-key-map' before PC Selection mode had changed that +association.") + +;;;; +;; misc +;;;; + +(provide 'pc-select) + +(defun pc-select-define-keys (alist keymap) + "Make KEYMAP have the key bindings specified in ALIST." + (let ((lst alist)) + (while lst + (define-key keymap (caar lst) (cdar lst)) + (setq lst (cdr lst))))) + +(defun pc-select-restore-keys (alist keymap saved-map) + "Use ALIST to restore key bindings from SAVED-MAP into KEYMAP. +Go through all the key bindings in ALIST, and, for each key +binding, if KEYMAP and ALIST still agree on the key binding, +restore the previous value of that key binding from SAVED-MAP." + (let ((lst alist)) + (while lst + (when (equal (lookup-key keymap (caar lst)) (cdar lst)) + (define-key keymap (caar lst) (lookup-key saved-map (caar lst)))) + (setq lst (cdr lst))))) + +(defmacro pc-select-add-to-alist (alist var val) + "Ensure that ALIST contains the cons cell (VAR . VAL). +If a cons cell whose car is VAR is already on the ALIST, update the +cdr of that cell with VAL. Otherwise, make a new cons cell +\(VAR . VAL), and prepend it onto ALIST." + (let ((elt (make-symbol "elt"))) + `(let ((,elt (assq ',var ,alist))) + (if ,elt + (setcdr ,elt ,val) + (setq ,alist (cons (cons ',var ,val) ,alist)))))) + +(defmacro pc-select-save-and-set-var (var newval) + "Set VAR to NEWVAL; save the old value. +The old value is saved on the `pc-select-saved-settings-alist'." + `(when (boundp ',var) + (pc-select-add-to-alist pc-select-saved-settings-alist ,var ,var) + (setq ,var ,newval))) + +(defmacro pc-select-save-and-set-mode (mode &optional arg mode-var) + "Call the function MODE; save the old value of the variable MODE. +MODE is presumed to be a function which turns on a minor mode. First, +save the value of the variable MODE on `pc-select-saved-settings-alist'. +Then, if ARG is specified, call MODE with ARG, otherwise call it with +nil as an argument. If MODE-VAR is specified, save the value of the +variable MODE-VAR (instead of the value of the variable MODE) on +`pc-select-saved-settings-alist'." + (unless mode-var (setq mode-var mode)) + `(when (fboundp ',mode) + (pc-select-add-to-alist pc-select-saved-settings-alist + ,mode-var ,mode-var) + (,mode ,arg))) + +(defmacro pc-select-restore-var (var) + "Restore the previous value of the variable VAR. +Look up VAR's previous value in `pc-select-saved-settings-alist', and, +if the value is found, set VAR to that value." + (let ((elt (make-symbol "elt"))) + `(let ((,elt (assq ',var pc-select-saved-settings-alist))) + (unless (null ,elt) + (setq ,var (cdr ,elt)))))) + +(defmacro pc-select-restore-mode (mode) + "Restore the previous state (either on or off) of the minor mode MODE. +Look up the value of the variable MODE on `pc-select-saved-settings-alist'. +If the value is non-nil, call the function MODE with an argument of +1, otherwise call it with an argument of -1." + (let ((elt (make-symbol "elt"))) + `(when (fboundp ',mode) + (let ((,elt (assq ',mode pc-select-saved-settings-alist))) + (unless (null ,elt) + (,mode (if (cdr ,elt) 1 -1))))))) + + +;;;###autoload +(define-minor-mode pc-selection-mode + "Change mark behavior to emulate Motif, Mac or MS-Windows cut and paste style. + +This mode enables Delete Selection mode and Transient Mark mode. + +The arrow keys (and others) are bound to new functions +which modify the status of the mark. + +The ordinary arrow keys disable the mark. +The shift-arrow keys move, leaving the mark behind. + +C-LEFT and C-RIGHT move back or forward one word, disabling the mark. +S-C-LEFT and S-C-RIGHT move back or forward one word, leaving the mark behind. + +M-LEFT and M-RIGHT move back or forward one word or sexp, disabling the mark. +S-M-LEFT and S-M-RIGHT move back or forward one word or sexp, leaving the mark +behind. To control whether these keys move word-wise or sexp-wise set the +variable `pc-select-meta-moves-sexps' after loading pc-select.el but before +turning PC Selection mode on. + +C-DOWN and C-UP move back or forward a paragraph, disabling the mark. +S-C-DOWN and S-C-UP move back or forward a paragraph, leaving the mark behind. + +HOME moves to beginning of line, disabling the mark. +S-HOME moves to beginning of line, leaving the mark behind. +With Ctrl or Meta, these keys move to beginning of buffer instead. + +END moves to end of line, disabling the mark. +S-END moves to end of line, leaving the mark behind. +With Ctrl or Meta, these keys move to end of buffer instead. + +PRIOR or PAGE-UP scrolls and disables the mark. +S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind. + +S-DELETE kills the region (`kill-region'). +S-INSERT yanks text from the kill ring (`yank'). +C-INSERT copies the region into the kill ring (`copy-region-as-kill'). + +In addition, certain other PC bindings are imitated (to avoid this, set +the variable `pc-select-selection-keys-only' to t after loading pc-select.el +but before calling PC Selection mode): + + F6 other-window + DELETE delete-char + C-DELETE kill-line + M-DELETE kill-word + C-M-DELETE kill-sexp + C-BACKSPACE backward-kill-word + M-BACKSPACE undo" + ;; FIXME: bring pc-bindings-mode here ? + nil nil nil + + :group 'pc-select + :global t + + (if pc-selection-mode + (if (null pc-select-key-bindings-alist) + (progn + (setq pc-select-saved-global-map (copy-keymap (current-global-map))) + (setq pc-select-key-bindings-alist + (append pc-select-default-key-bindings + (if pc-select-selection-keys-only + nil + pc-select-extra-key-bindings) + (if pc-select-meta-moves-sexps + (car pc-select-meta-moves-sexps-key-bindings) + (cadr pc-select-meta-moves-sexps-key-bindings)) + (if (or pc-select-selection-keys-only + (eq window-system 'x) + (memq system-name '(ms-dos windows-nt))) + nil + pc-select-tty-key-bindings))) + + (pc-select-define-keys pc-select-key-bindings-alist + (current-global-map)) + + (unless (or pc-select-selection-keys-only + (eq window-system 'x) + (memq system-name '(ms-dos windows-nt))) + ;; it is not clear that we need the following line + ;; I hope it doesn't do too much harm to leave it in, though... + (setq pc-select-old-M-delete-binding + (lookup-key function-key-map [M-delete])) + (define-key function-key-map [M-delete] [?\M-d])) + + (when (and (not pc-select-selection-keys-only) + (or (eq window-system 'x) + (memq system-name '(ms-dos windows-nt))) + (fboundp 'normal-erase-is-backspace-mode)) + (pc-select-save-and-set-mode normal-erase-is-backspace-mode 1 + normal-erase-is-backspace)) + ;; the original author also had this above: + ;; (setq-default normal-erase-is-backspace t) + ;; However, the documentation for the variable says that + ;; "setting it with setq has no effect", so I'm removing it. + + (pc-select-save-and-set-var highlight-nonselected-windows nil) + (pc-select-save-and-set-var transient-mark-mode t) + (pc-select-save-and-set-var shift-select-mode t) + (pc-select-save-and-set-var mark-even-if-inactive t) + (pc-select-save-and-set-mode delete-selection-mode 1)) + ;;else + ;; If the user turned on pc-selection-mode a second time + ;; do not clobber the values of the variables that were + ;; saved from before pc-selection mode was activated -- + ;; just make sure the values are the way we like them. + (pc-select-define-keys pc-select-key-bindings-alist + (current-global-map)) + (unless (or pc-select-selection-keys-only + (eq window-system 'x) + (memq system-name '(ms-dos windows-nt))) + ;; it is not clear that we need the following line + ;; I hope it doesn't do too much harm to leave it in, though... + (define-key function-key-map [M-delete] [?\M-d])) + (when (and (not pc-select-selection-keys-only) + (or (eq window-system 'x) + (memq system-name '(ms-dos windows-nt))) + (fboundp 'normal-erase-is-backspace-mode)) + (normal-erase-is-backspace-mode 1)) + (setq highlight-nonselected-windows nil) + (setq transient-mark-mode t) + (setq mark-even-if-inactive t) + (delete-selection-mode 1)) + ;;else + (when pc-select-key-bindings-alist + (when (and (not pc-select-selection-keys-only) + (or (eq window-system 'x) + (memq system-name '(ms-dos windows-nt)))) + (pc-select-restore-mode normal-erase-is-backspace-mode)) + + (pc-select-restore-keys + pc-select-key-bindings-alist (current-global-map) + pc-select-saved-global-map) + + (pc-select-restore-var highlight-nonselected-windows) + (pc-select-restore-var transient-mark-mode) + (pc-select-restore-var shift-select-mode) + (pc-select-restore-var mark-even-if-inactive) + (pc-select-restore-mode delete-selection-mode) + (and pc-select-old-M-delete-binding + (define-key function-key-map [M-delete] + pc-select-old-M-delete-binding)) + (setq pc-select-key-bindings-alist nil + pc-select-saved-settings-alist nil)))) +(make-obsolete 'pc-selection-mode 'delete-selection-mode "24.1") + +;;; pc-select.el ends here diff --git a/lisp/obsolete/spell.el b/lisp/obsolete/spell.el index a97a6dce52..ec7f912455 100644 --- a/lisp/obsolete/spell.el +++ b/lisp/obsolete/spell.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: wp, unix ;; Obsolete-since: 23.1 +;; (not in obsolete/ directory then, but all functions marked obsolete) ;; This file is part of GNU Emacs. diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index b35cf0738b..5f0908e11c 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,8 @@ +2011-02-10 Stefan Monnier <[email protected]> + + * org-remember.el (org-remember-mode-map): + * org-src.el (org-src-mode-map): Move initialization into declaration. + 2011-01-13 Stefan Monnier <[email protected]> * org-remember.el (org-remember-mode): diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el index 80f9dadd7a..fd3064a709 100644 --- a/lisp/org/org-remember.el +++ b/lisp/org/org-remember.el @@ -214,7 +214,11 @@ The remember buffer is still current when this hook runs." :group 'org-remember :type 'hook) -(defvar org-remember-mode-map (make-sparse-keymap) +(defvar org-remember-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'org-remember-finalize) + (define-key map "\C-c\C-k" 'org-remember-kill) + map) "Keymap for `org-remember-mode', a minor mode. Use this map to set additional keybindings for when Org-mode is used for a Remember buffer.") @@ -224,8 +228,6 @@ for a Remember buffer.") (define-minor-mode org-remember-mode "Minor mode for special key bindings in a remember buffer." nil " Rem" org-remember-mode-map) -(define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize) -(define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill) (defcustom org-remember-clock-out-on-exit 'query "Non-nil means stop the clock when exiting a clocking remember buffer. diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el index 07779700da..98fdb75423 100644 --- a/lisp/org/org-src.el +++ b/lisp/org/org-src.el @@ -169,8 +169,10 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is ;;; Editing source examples -(defvar org-src-mode-map (make-sparse-keymap)) -(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) +(defvar org-src-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c'" 'org-edit-src-exit) + map)) (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) diff --git a/lisp/play/gametree.el b/lisp/play/gametree.el index d0ba9b037e..cd353d27f0 100644 --- a/lisp/play/gametree.el +++ b/lisp/play/gametree.el @@ -565,6 +565,20 @@ buffer, it is replaced by the new value. See the documentation for (gametree-hack-file-layout)) nil) +;;;; Key bindings +(defvar gametree-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-j" 'gametree-break-line-here) + (define-key map "\C-c\C-v" 'gametree-insert-new-leaf) + (define-key map "\C-c\C-m" 'gametree-merge-line) + (define-key map "\C-c\C-r " 'gametree-layout-to-register) + (define-key map "\C-c\C-r/" 'gametree-layout-to-register) + (define-key map "\C-c\C-rj" 'gametree-apply-register-layout) + (define-key map "\C-c\C-y" 'gametree-save-and-hack-layout) + (define-key map "\C-c;" 'gametree-insert-score) + (define-key map "\C-c^" 'gametree-compute-and-insert-score) + map)) + (define-derived-mode gametree-mode outline-mode "GameTree" "Major mode for managing game analysis trees. Useful to postal and email chess (and, it is hoped, also checkers, go, @@ -575,18 +589,6 @@ shogi, etc.) players, it is a slightly modified version of Outline mode. (make-local-variable 'write-contents-hooks) (add-hook 'write-contents-hooks 'gametree-save-and-hack-layout)) -;;;; Key bindings - -(define-key gametree-mode-map "\C-c\C-j" 'gametree-break-line-here) -(define-key gametree-mode-map "\C-c\C-v" 'gametree-insert-new-leaf) -(define-key gametree-mode-map "\C-c\C-m" 'gametree-merge-line) -(define-key gametree-mode-map "\C-c\C-r " 'gametree-layout-to-register) -(define-key gametree-mode-map "\C-c\C-r/" 'gametree-layout-to-register) -(define-key gametree-mode-map "\C-c\C-rj" 'gametree-apply-register-layout) -(define-key gametree-mode-map "\C-c\C-y" 'gametree-save-and-hack-layout) -(define-key gametree-mode-map "\C-c;" 'gametree-insert-score) -(define-key gametree-mode-map "\C-c^" 'gametree-compute-and-insert-score) - ;;;; Goodies for mousing users (and (fboundp 'track-mouse) (defun gametree-mouse-break-line-here (event) diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el index 5bab360f9f..601232e432 100644 --- a/lisp/play/handwrite.el +++ b/lisp/play/handwrite.el @@ -80,8 +80,24 @@ (defvar handwrite-psindex 0 "The index of the PostScript buffer.") -(defvar menu-bar-handwrite-map (make-sparse-keymap "Handwrite functions.")) -(fset 'menu-bar-handwrite-map (symbol-value 'menu-bar-handwrite-map)) +(defvar menu-bar-handwrite-map + (let ((map (make-sparse-keymap "Handwrite functions."))) + (define-key map [numbering] + '(menu-item "Page numbering" handwrite-set-pagenumber + :button (:toggle . handwrite-pagenumbering))) + (define-key map [handwrite-separator2] '("----" . nil)) + (define-key map [10pt] '(menu-item "10 pt" handwrite-10pt + :button (:radio . (eq handwrite-fontsize 10)))) + (define-key map [11pt] '(menu-item "11 pt" handwrite-11pt + :button (:radio . (eq handwrite-fontsize 11)))) + (define-key map [12pt] '(menu-item "12 pt" handwrite-12pt + :button (:radio . (eq handwrite-fontsize 12)))) + (define-key map [13pt] '(menu-item "13 pt" handwrite-13pt + :button (:radio . (eq handwrite-fontsize 13)))) + (define-key map [handwrite-separator1] '("----" . nil)) + (define-key map [handwrite] '("Write by hand" . handwrite)) + map)) +(fset 'menu-bar-handwrite-map menu-bar-handwrite-map) ;; User definable variables @@ -135,10 +151,10 @@ The functions `handwrite-10pt', `handwrite-11pt', `handwrite-12pt' and `handwrite-13pt' set up for various sizes of output. -Variables: handwrite-linespace (default 12) - handwrite-fontsize (default 11) - handwrite-numlines (default 60) - handwrite-pagenumbering (default nil)" +Variables: `handwrite-linespace' (default 12) + `handwrite-fontsize' (default 11) + `handwrite-numlines' (default 60) + `handwrite-pagenumbering' (default nil)" (interactive) (let ((pmin) ; thanks, Havard @@ -258,7 +274,8 @@ Variables: handwrite-linespace (default 12) "Toggle the value of `handwrite-pagenumbering'." (interactive) (if handwrite-pagenumbering - (handwrite-set-pagenumber-off)(handwrite-set-pagenumber-on))) + (handwrite-set-pagenumber-off) + (handwrite-set-pagenumber-on))) (defun handwrite-10pt () "Specify 10-point output for `handwrite. @@ -268,14 +285,6 @@ values for `handwrite-linespace' and `handwrite-numlines'." (setq handwrite-fontsize 10) (setq handwrite-linespace 11) (setq handwrite-numlines handwrite-10pt-numlines) - (define-key menu-bar-handwrite-map [10pt] - '("10 pt *" . handwrite-10pt)) - (define-key menu-bar-handwrite-map [11pt] - '("11 pt" . handwrite-11pt)) - (define-key menu-bar-handwrite-map [12pt] - '("12 pt" . handwrite-12pt)) - (define-key menu-bar-handwrite-map [13pt] - '("13 pt" . handwrite-13pt)) (message "Handwrite output size set to 10 points")) @@ -287,14 +296,6 @@ values for `handwrite-linespace' and `handwrite-numlines'." (setq handwrite-fontsize 11) (setq handwrite-linespace 12) (setq handwrite-numlines handwrite-11pt-numlines) - (define-key menu-bar-handwrite-map [10pt] - '("10 pt" . handwrite-10pt)) - (define-key menu-bar-handwrite-map [11pt] - '("11 pt *" . handwrite-11pt)) - (define-key menu-bar-handwrite-map [12pt] - '("12 pt" . handwrite-12pt)) - (define-key menu-bar-handwrite-map [13pt] - '("13 pt" . handwrite-13pt)) (message "Handwrite output size set to 11 points")) (defun handwrite-12pt () @@ -305,14 +306,6 @@ values for `handwrite-linespace' and `handwrite-numlines'." (setq handwrite-fontsize 12) (setq handwrite-linespace 13) (setq handwrite-numlines handwrite-12pt-numlines) - (define-key menu-bar-handwrite-map [10pt] - '("10 pt" . handwrite-10pt)) - (define-key menu-bar-handwrite-map [11pt] - '("11 pt" . handwrite-11pt)) - (define-key menu-bar-handwrite-map [12pt] - '("12 pt *" . handwrite-12pt)) - (define-key menu-bar-handwrite-map [13pt] - '("13 pt" . handwrite-13pt)) (message "Handwrite output size set to 12 points")) (defun handwrite-13pt () @@ -323,14 +316,6 @@ values for `handwrite-linespace' and `handwrite-numlines'." (setq handwrite-fontsize 13) (setq handwrite-linespace 14) (setq handwrite-numlines handwrite-13pt-numlines) - (define-key menu-bar-handwrite-map [10pt] - '("10 pt" . handwrite-10pt)) - (define-key menu-bar-handwrite-map [11pt] - '("11 pt" . handwrite-11pt)) - (define-key menu-bar-handwrite-map [12pt] - '("12 pt" . handwrite-12pt)) - (define-key menu-bar-handwrite-map [13pt] - '("13 pt *" . handwrite-13pt)) (message "Handwrite output size set to 13 points")) @@ -1263,62 +1248,24 @@ end ;;Sets page numbering off (defun handwrite-set-pagenumber-off () (setq handwrite-pagenumbering nil) - (define-key menu-bar-handwrite-map - [numbering] - '("Page numbering Off" . handwrite-set-pagenumber)) (message "page numbering off")) ;;Sets page numbering on (defun handwrite-set-pagenumber-on () (setq handwrite-pagenumbering t) - (define-key menu-bar-handwrite-map - [numbering] - '("Page numbering On" . handwrite-set-pagenumber)) (message "page numbering on" )) ;; Key bindings - -;;; I'd rather not fill up the menu bar menus with -;;; lots of random miscellaneous features. -- rms. +;; I'd rather not fill up the menu bar menus with +;; lots of random miscellaneous features. -- rms. ;;;(define-key-after ;;; (lookup-key global-map [menu-bar edit]) ;;; [handwrite] ;;; '("Write by hand" . menu-bar-handwrite-map) ;;; 'spell) -(define-key menu-bar-handwrite-map [numbering] - '("Page numbering Off" . handwrite-set-pagenumber)) - -(define-key menu-bar-handwrite-map [10pt] - '("10 pt" . handwrite-10pt)) - -(define-key menu-bar-handwrite-map [11pt] - '("11 pt *" . handwrite-11pt)) - -(define-key menu-bar-handwrite-map [12pt] - '("12 pt" . handwrite-12pt)) - -(define-key menu-bar-handwrite-map [13pt] - '("13 pt" . handwrite-13pt)) - -(define-key menu-bar-handwrite-map [handwrite] - '("Write by hand" . handwrite)) - -(define-key-after - (lookup-key menu-bar-handwrite-map [ ]) - [handwrite-separator1] - '("----" . nil) - 'handwrite) - -(define-key-after - (lookup-key menu-bar-handwrite-map [ ]) - [handwrite-separator2] - '("----" . nil) - '10pt) - - (provide 'handwrite) diff --git a/lisp/play/pong.el b/lisp/play/pong.el index a291283170..e993e76975 100644 --- a/lisp/play/pong.el +++ b/lisp/play/pong.el @@ -190,21 +190,23 @@ ;;; Initialize maps (defvar pong-mode-map - (make-sparse-keymap 'pong-mode-map) "Modemap for pong-mode.") + (let ((map (make-sparse-keymap 'pong-mode-map))) + (define-key map [left] 'pong-move-left) + (define-key map [right] 'pong-move-right) + (define-key map [up] 'pong-move-up) + (define-key map [down] 'pong-move-down) + (define-key map pong-left-key 'pong-move-left) + (define-key map pong-right-key 'pong-move-right) + (define-key map pong-up-key 'pong-move-up) + (define-key map pong-down-key 'pong-move-down) + (define-key map pong-quit-key 'pong-quit) + (define-key map pong-pause-key 'pong-pause) + map) + "Modemap for pong-mode.") (defvar pong-null-map (make-sparse-keymap 'pong-null-map) "Null map for pong-mode.") -(define-key pong-mode-map [left] 'pong-move-left) -(define-key pong-mode-map [right] 'pong-move-right) -(define-key pong-mode-map [up] 'pong-move-up) -(define-key pong-mode-map [down] 'pong-move-down) -(define-key pong-mode-map pong-left-key 'pong-move-left) -(define-key pong-mode-map pong-right-key 'pong-move-right) -(define-key pong-mode-map pong-up-key 'pong-move-up) -(define-key pong-mode-map pong-down-key 'pong-move-down) -(define-key pong-mode-map pong-quit-key 'pong-quit) -(define-key pong-mode-map pong-pause-key 'pong-pause) ;;; Fun stuff -- The code diff --git a/lisp/play/snake.el b/lisp/play/snake.el index 3714e6be4d..418c898e82 100644 --- a/lisp/play/snake.el +++ b/lisp/play/snake.el @@ -174,21 +174,22 @@ and then start moving it leftwards.") ;; ;;;;;;;;;;;;; keymaps ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar snake-mode-map - (make-sparse-keymap 'snake-mode-map)) + (let ((map (make-sparse-keymap 'snake-mode-map))) -(define-key snake-mode-map "n" 'snake-start-game) -(define-key snake-mode-map "q" 'snake-end-game) -(define-key snake-mode-map "p" 'snake-pause-game) + (define-key map "n" 'snake-start-game) + (define-key map "q" 'snake-end-game) + (define-key map "p" 'snake-pause-game) -(define-key snake-mode-map [left] 'snake-move-left) -(define-key snake-mode-map [right] 'snake-move-right) -(define-key snake-mode-map [up] 'snake-move-up) -(define-key snake-mode-map [down] 'snake-move-down) + (define-key map [left] 'snake-move-left) + (define-key map [right] 'snake-move-right) + (define-key map [up] 'snake-move-up) + (define-key map [down] 'snake-move-down) + map)) (defvar snake-null-map - (make-sparse-keymap 'snake-null-map)) - -(define-key snake-null-map "n" 'snake-start-game) + (let ((map (make-sparse-keymap 'snake-null-map))) + (define-key map "n" 'snake-start-game) + map)) ;; ;;;;;;;;;;;;;;;; game functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el index d58a81b5ae..9d6a0ef52b 100644 --- a/lisp/play/solitaire.el +++ b/lisp/play/solitaire.el @@ -43,7 +43,7 @@ (defvar solitaire-mode-map (let ((map (make-sparse-keymap))) - (suppress-keymap map t) + (set-keymap-parent map special-mode-map) (define-key map "\C-f" 'solitaire-right) (define-key map "\C-b" 'solitaire-left) @@ -52,7 +52,6 @@ (define-key map "\r" 'solitaire-move) (define-key map [remap undo] 'solitaire-undo) (define-key map " " 'solitaire-do-check) - (define-key map "q" 'quit-window) (define-key map [right] 'solitaire-right) (define-key map [left] 'solitaire-left) @@ -88,7 +87,7 @@ ;; Solitaire mode is suitable only for specially formatted data. (put 'solitaire-mode 'mode-class 'special) -(define-derived-mode solitaire-mode nil "Solitaire" +(define-derived-mode solitaire-mode special-mode "Solitaire" "Major mode for playing Solitaire. To learn how to play Solitaire, see the documentation for function `solitaire'. @@ -197,7 +196,6 @@ Pick your favourite shortcuts: (interactive "P") (switch-to-buffer "*Solitaire*") - (solitaire-mode) (setq buffer-read-only t) (setq solitaire-stones 32) (solitaire-insert-board) @@ -205,7 +203,7 @@ Pick your favourite shortcuts: (goto-char (point-max)) (setq solitaire-center (search-backward ".")) (setq buffer-undo-list (list (point))) - (set-buffer-modified-p nil)) + (solitaire-mode)) (defun solitaire-build-modeline () (setq mode-line-format diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 327ebea40c..ec913e05c7 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -2440,13 +2440,15 @@ function does not require the declaration to contain a brace block." (goto-char last) (throw 'done '(nil . nil))) - ;; Stop if we encounter a preprocessor line. - ((and (not macro-end) + ;; Stop if we encounter a preprocessor line. Continue if we + ;; hit a naked # + ((and c-opt-cpp-prefix + (not macro-end) (eq (char-after) ?#) (= (point) (c-point 'boi))) - (goto-char last) - ;(throw 'done (cons (eq (point) here) 'macro-boundary))) ; Changed 2003/3/26 - (throw 'done '(t . macro-boundary))) + (if (= (point) here) ; Not a macro, therefore naked #. + (forward-char) + (throw 'done '(t . macro-boundary)))) ;; Stop after a ';', '}', or "};" ((looking-at ";\\|};?") @@ -2560,14 +2562,21 @@ be more \"DWIM:ey\"." (c-backward-syntactic-ws)) (or (bobp) (c-after-statement-terminator-p))))))) ;; Are we about to move backwards into or out of a - ;; preprocessor command? If so, locate it's beginning. + ;; preprocessor command? If so, locate its beginning. (when (eq (cdr res) 'macro-boundary) - (save-excursion - (beginning-of-line) - (setq macro-fence - (and (not (bobp)) - (progn (c-skip-ws-backward) (c-beginning-of-macro)) - (point))))) + (setq macro-fence + (save-excursion + (if macro-fence + (progn + (end-of-line) + (and (not (eobp)) + (progn (c-skip-ws-forward) + (c-beginning-of-macro)) + (progn (c-end-of-macro) + (point)))) + (and (not (eobp)) + (c-beginning-of-macro) + (progn (c-end-of-macro) (point))))))) ;; Are we about to move backwards into a literal? (when (memq (cdr res) '(macro-boundary literal)) (setq range (c-ascertain-preceding-literal))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 406ee1a91d..f90d29bf00 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -5371,6 +5371,8 @@ comment at the start of cc-engine.el for more info." ;; cc-mode requires cc-fonts. (declare-function c-fontify-recorded-types-and-refs "cc-fonts" ()) +(defvar c-forward-<>-arglist-recur-depth) + (defun c-forward-<>-arglist (all-types) ;; The point is assumed to be at a "<". Try to treat it as the open ;; paren of an angle bracket arglist and move forward to the @@ -5396,7 +5398,8 @@ comment at the start of cc-engine.el for more info." ;; If `c-record-type-identifiers' is set then activate ;; recording of any found types that constitute an argument in ;; the arglist. - (c-record-found-types (if c-record-type-identifiers t))) + (c-record-found-types (if c-record-type-identifiers t)) + (c-forward-<>-arglist-recur--depth 0)) (if (catch 'angle-bracket-arglist-escape (setq c-record-found-types (c-forward-<>-arglist-recur all-types))) @@ -5413,6 +5416,14 @@ comment at the start of cc-engine.el for more info." nil))) (defun c-forward-<>-arglist-recur (all-types) + + ;; Temporary workaround for Bug#7722. + (when (boundp 'c-forward-<>-arglist-recur--depth) + (if (> c-forward-<>-arglist-recur--depth 200) + (error "Max recursion depth reached in <> arglist") + (setq c-forward-<>-arglist-recur--depth + (1+ c-forward-<>-arglist-recur--depth)))) + ;; Recursive part of `c-forward-<>-arglist'. ;; ;; This function might do hidden buffer changes. diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 5dde9ba9a9..b41eb82e27 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -633,34 +633,25 @@ starting the compilation process.") :version "22.1") (defface compilation-warning - '((((class color) (min-colors 16)) (:foreground "Orange" :weight bold)) - (((class color)) (:foreground "cyan" :weight bold)) - (t (:weight bold))) + '((t :inherit font-lock-variable-name-face)) "Face used to highlight compiler warnings." :group 'compilation :version "22.1") (defface compilation-info - '((((class color) (min-colors 16) (background light)) - (:foreground "Green3" :weight bold)) - (((class color) (min-colors 88) (background dark)) - (:foreground "Green1" :weight bold)) - (((class color) (min-colors 16) (background dark)) - (:foreground "Green" :weight bold)) - (((class color)) (:foreground "green" :weight bold)) - (t (:weight bold))) + '((t :inherit font-lock-type-face)) "Face used to highlight compiler information." :group 'compilation :version "22.1") (defface compilation-line-number - '((t :inherit font-lock-variable-name-face)) + '((t :inherit font-lock-keyword-face)) "Face for displaying line numbers in compiler messages." :group 'compilation :version "22.1") (defface compilation-column-number - '((t :inherit font-lock-type-face)) + '((t :inherit font-lock-doc-face)) "Face for displaying column numbers in compiler messages." :group 'compilation :version "22.1") @@ -693,7 +684,7 @@ Faces `compilation-error-face', `compilation-warning-face', (defvar compilation-enter-directory-face 'font-lock-function-name-face "Face name to use for entering directory messages.") -(defvar compilation-leave-directory-face 'font-lock-type-face +(defvar compilation-leave-directory-face 'font-lock-builtin-face "Face name to use for leaving directory messages.") @@ -862,7 +853,7 @@ POS and RES.") (< (cdr compilation--previous-directory-cache) pos))) ;; No need to call previous-single-property-change. (cdr compilation--previous-directory-cache) - + (let* ((cache (and compilation--previous-directory-cache (<= (car compilation--previous-directory-cache) pos) (car compilation--previous-directory-cache))) @@ -1711,6 +1702,7 @@ Returns the compilation buffer created." (defvar compilation-minor-mode-map (let ((map (make-sparse-keymap))) + (set-keymap-parent map special-mode-map) (define-key map [mouse-2] 'compile-goto-error) (define-key map [follow-link] 'mouse-face) (define-key map "\C-c\C-c" 'compile-goto-error) @@ -1721,7 +1713,6 @@ Returns the compilation buffer created." (define-key map "\M-{" 'compilation-previous-file) (define-key map "\M-}" 'compilation-next-file) (define-key map "g" 'recompile) ; revert - (define-key map "q" 'quit-window) ;; Set up the menu-bar (define-key map [menu-bar compilation] (cons "Errors" compilation-menu-map)) @@ -1755,6 +1746,7 @@ Returns the compilation buffer created." ;; Don't inherit from compilation-minor-mode-map, ;; because that introduces a menu bar item we don't want. ;; That confuses C-down-mouse-3. + (set-keymap-parent map special-mode-map) (define-key map [mouse-2] 'compile-goto-error) (define-key map [follow-link] 'mouse-face) (define-key map "\C-c\C-c" 'compile-goto-error) @@ -1767,10 +1759,7 @@ Returns the compilation buffer created." (define-key map "\t" 'compilation-next-error) (define-key map [backtab] 'compilation-previous-error) (define-key map "g" 'recompile) ; revert - (define-key map "q" 'quit-window) - (define-key map " " 'scroll-up) - (define-key map "\^?" 'scroll-down) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) ;; Set up the menu-bar @@ -2140,7 +2129,7 @@ looking for the next message." (or pt (setq pt (point))) (let* ((msg (get-text-property pt 'compilation-message)) ;; `loc', `msg', and `last' are used by the compilation-loop macro. - (loc (compilation--message->loc msg)) + (loc (and msg (compilation--message->loc msg))) last) (if (zerop n) (unless (or msg ; find message near here @@ -2154,8 +2143,7 @@ looking for the next message." (line-end-position))) (or (setq msg (get-text-property pt 'compilation-message)) (setq pt (point))))) - (setq last (compilation--loc->file-struct - (compilation--message->loc msg))) + (setq last (compilation--loc->file-struct loc)) (if (>= n 0) (compilation-loop > compilation-next-single-property-change 1- (if (get-buffer-process (current-buffer)) diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el index c46120bbd6..ed745ae784 100644 --- a/lisp/progmodes/f90.el +++ b/lisp/progmodes/f90.el @@ -2198,6 +2198,16 @@ CHANGE-WORD should be one of 'upcase-word, 'downcase-word, 'capitalize-word." (save-excursion (nth 1 (f90-beginning-of-subprogram)))) +(defun f90-find-tag-default () + "Function to use for `find-tag-default-function' property in F90 mode." + (let ((tag (find-tag-default))) + (or (and tag + ;; See bug#7919. TODO I imagine there are other cases...? + (string-match "%\\(.+\\)" tag) + (match-string-no-properties 1 tag)) + tag))) + +(put 'f90-mode 'find-tag-default-function 'f90-find-tag-default) (defun f90-backslash-not-special (&optional all) "Make the backslash character (\\) be non-special in the current buffer. diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index ce7de946b5..25d1410621 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -2347,7 +2347,8 @@ HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See (bindat-get-field breakpoint 'what) (or pending at (concat "in " - (propertize func 'font-lock-face font-lock-function-name-face) + (propertize (or func "unknown") + 'font-lock-face font-lock-function-name-face) (gdb-frame-location breakpoint))))) ;; Add clickable properties only for breakpoints with file:line ;; information @@ -2982,25 +2983,27 @@ DOC is an optional documentation string." map) "Keymap to select format in the header line.") -(defvar gdb-memory-format-menu (make-sparse-keymap "Format") +(defvar gdb-memory-format-menu + (let ((map (make-sparse-keymap "Format"))) + + (define-key map [binary] + '(menu-item "Binary" gdb-memory-format-binary + :button (:radio . (equal gdb-memory-format "t")))) + (define-key map [octal] + '(menu-item "Octal" gdb-memory-format-octal + :button (:radio . (equal gdb-memory-format "o")))) + (define-key map [unsigned] + '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned + :button (:radio . (equal gdb-memory-format "u")))) + (define-key map [signed] + '(menu-item "Signed Decimal" gdb-memory-format-signed + :button (:radio . (equal gdb-memory-format "d")))) + (define-key map [hexadecimal] + '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal + :button (:radio . (equal gdb-memory-format "x")))) + map) "Menu of display formats in the header line.") -(define-key gdb-memory-format-menu [binary] - '(menu-item "Binary" gdb-memory-format-binary - :button (:radio . (equal gdb-memory-format "t")))) -(define-key gdb-memory-format-menu [octal] - '(menu-item "Octal" gdb-memory-format-octal - :button (:radio . (equal gdb-memory-format "o")))) -(define-key gdb-memory-format-menu [unsigned] - '(menu-item "Unsigned Decimal" gdb-memory-format-unsigned - :button (:radio . (equal gdb-memory-format "u")))) -(define-key gdb-memory-format-menu [signed] - '(menu-item "Signed Decimal" gdb-memory-format-signed - :button (:radio . (equal gdb-memory-format "d")))) -(define-key gdb-memory-format-menu [hexadecimal] - '(menu-item "Hexadecimal" gdb-memory-format-hexadecimal - :button (:radio . (equal gdb-memory-format "x")))) - (defun gdb-memory-format-menu (event) (interactive "@e") (x-popup-menu event gdb-memory-format-menu)) @@ -3060,22 +3063,23 @@ DOC is an optional documentation string." map) "Keymap to select units in the header line.") -(defvar gdb-memory-unit-menu (make-sparse-keymap "Unit") +(defvar gdb-memory-unit-menu + (let ((map (make-sparse-keymap "Unit"))) + (define-key map [giantwords] + '(menu-item "Giant words" gdb-memory-unit-giant + :button (:radio . (equal gdb-memory-unit 8)))) + (define-key map [words] + '(menu-item "Words" gdb-memory-unit-word + :button (:radio . (equal gdb-memory-unit 4)))) + (define-key map [halfwords] + '(menu-item "Halfwords" gdb-memory-unit-halfword + :button (:radio . (equal gdb-memory-unit 2)))) + (define-key map [bytes] + '(menu-item "Bytes" gdb-memory-unit-byte + :button (:radio . (equal gdb-memory-unit 1)))) + map) "Menu of units in the header line.") -(define-key gdb-memory-unit-menu [giantwords] - '(menu-item "Giant words" gdb-memory-unit-giant - :button (:radio . (equal gdb-memory-unit 8)))) -(define-key gdb-memory-unit-menu [words] - '(menu-item "Words" gdb-memory-unit-word - :button (:radio . (equal gdb-memory-unit 4)))) -(define-key gdb-memory-unit-menu [halfwords] - '(menu-item "Halfwords" gdb-memory-unit-halfword - :button (:radio . (equal gdb-memory-unit 2)))) -(define-key gdb-memory-unit-menu [bytes] - '(menu-item "Bytes" gdb-memory-unit-byte - :button (:radio . (equal gdb-memory-unit 1)))) - (defun gdb-memory-unit-menu (event) (interactive "@e") (x-popup-menu event gdb-memory-unit-menu)) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 4bab8a18de..32ab52228f 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -388,13 +388,13 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies 1 grep-error-face) ;; remove match from grep-regexp-alist before fontifying ("^Grep[/a-zA-z]* started.*" - (0 '(face nil message nil help-echo nil mouse-face nil) t)) + (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)) ("^Grep[/a-zA-z]* finished \\(?:(\\(matches found\\))\\|with \\(no matches found\\)\\).*" - (0 '(face nil message nil help-echo nil mouse-face nil) t) + (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t) (1 compilation-info-face nil t) (2 compilation-warning-face nil t)) ("^Grep[/a-zA-z]* \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*" - (0 '(face nil message nil help-echo nil mouse-face nil) t) + (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t) (1 grep-error-face) (2 grep-error-face nil t)) ("^.+?-[0-9]+-.*\n" (0 grep-context-face)) diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index 1b32c7807c..7202d95c8d 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -219,23 +219,24 @@ support." ;; Define the key bindings for the Help application -(defvar idlwave-help-mode-map (make-sparse-keymap) +(defvar idlwave-help-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "q" 'idlwave-help-quit) + (define-key map "w" 'widen) + (define-key map "\C-m" (lambda (arg) + (interactive "p") + (scroll-up arg))) + (define-key map " " 'scroll-up) + (define-key map [delete] 'scroll-down) + (define-key map "h" 'idlwave-help-find-header) + (define-key map "H" 'idlwave-help-find-first-header) + (define-key map "." 'idlwave-help-toggle-header-match-and-def) + (define-key map "F" 'idlwave-help-fontify) + (define-key map "\M-?" 'idlwave-help-return-to-calling-frame) + (define-key map "x" 'idlwave-help-return-to-calling-frame) + map) "The keymap used in `idlwave-help-mode'.") -(define-key idlwave-help-mode-map "q" 'idlwave-help-quit) -(define-key idlwave-help-mode-map "w" 'widen) -(define-key idlwave-help-mode-map "\C-m" (lambda (arg) - (interactive "p") - (scroll-up arg))) -(define-key idlwave-help-mode-map " " 'scroll-up) -(define-key idlwave-help-mode-map [delete] 'scroll-down) -(define-key idlwave-help-mode-map "h" 'idlwave-help-find-header) -(define-key idlwave-help-mode-map "H" 'idlwave-help-find-first-header) -(define-key idlwave-help-mode-map "." 'idlwave-help-toggle-header-match-and-def) -(define-key idlwave-help-mode-map "F" 'idlwave-help-fontify) -(define-key idlwave-help-mode-map "\M-?" 'idlwave-help-return-to-calling-frame) -(define-key idlwave-help-mode-map "x" 'idlwave-help-return-to-calling-frame) - ;; Define the menu for the Help application (easy-menu-define diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 72b7914e21..30d9fc2186 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -8265,20 +8265,26 @@ If we do not know about MODULE, just return KEYWORD literally." ;; keyword - return it as it is. keyword)))) -(defvar idlwave-rinfo-mouse-map (make-sparse-keymap)) -(defvar idlwave-rinfo-map (make-sparse-keymap)) -(define-key idlwave-rinfo-mouse-map - (if (featurep 'xemacs) [button2] [mouse-2]) - 'idlwave-mouse-active-rinfo) -(define-key idlwave-rinfo-mouse-map - (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) - 'idlwave-mouse-active-rinfo-shift) -(define-key idlwave-rinfo-mouse-map - (if (featurep 'xemacs) [button3] [mouse-3]) - 'idlwave-mouse-active-rinfo-right) -(define-key idlwave-rinfo-mouse-map " " 'idlwave-active-rinfo-space) -(define-key idlwave-rinfo-map "q" 'idlwave-quit-help) -(define-key idlwave-rinfo-mouse-map "q" 'idlwave-quit-help) +(defvar idlwave-rinfo-mouse-map + (let ((map (make-sparse-keymap))) + (define-key map + (if (featurep 'xemacs) [button2] [mouse-2]) + 'idlwave-mouse-active-rinfo) + (define-key map + (if (featurep 'xemacs) [(shift button2)] [(shift mouse-2)]) + 'idlwave-mouse-active-rinfo-shift) + (define-key map + (if (featurep 'xemacs) [button3] [mouse-3]) + 'idlwave-mouse-active-rinfo-right) + (define-key map " " 'idlwave-active-rinfo-space) + (define-key map "q" 'idlwave-quit-help) + map)) + +(defvar idlwave-rinfo-map + (let ((map (make-sparse-keymap))) + (define-key map "q" 'idlwave-quit-help) + map)) + (defvar idlwave-popup-source nil) (defvar idlwave-rinfo-marker (make-marker)) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 64f8c62377..900072fe35 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -925,65 +925,16 @@ See `sh-feature'.") (defconst sh-st-punc (string-to-syntax ".")) (defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string -(defconst sh-escaped-line-re - ;; Should match until the real end-of-continued-line, but if that is not - ;; possible (because we bump into EOB or the search bound), then we should - ;; match until the search bound. - "\\(?:\\(?:.*[^\\\n]\\)?\\(?:\\\\\\\\\\)*\\\\\n\\)*.*") - -(defconst sh-here-doc-open-re - (concat "<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\)+\\)" - sh-escaped-line-re "\\(\n\\)")) - -(defvar sh-here-doc-markers nil) -(make-variable-buffer-local 'sh-here-doc-markers) -(defvar sh-here-doc-re sh-here-doc-open-re) -(make-variable-buffer-local 'sh-here-doc-re) - -(defun sh-font-lock-close-heredoc (bol eof indented eol) - "Determine the syntax of the \\n after an EOF. -If non-nil INDENTED indicates that the EOF was indented." - (let* ((eof-re (if eof (regexp-quote eof) "")) - ;; A rough regexp that should find the opening <<EOF back. - (sre (concat "<<\\(-?\\)\\s-*['\"\\]?" - ;; Use \s| to cheaply check it's an open-heredoc. - eof-re "['\"]?\\([ \t|;&)<>]" - sh-escaped-line-re - "\\)?\\s|")) - ;; A regexp that will find other EOFs. - (ere (concat "^" (if indented "[ \t]*") eof-re "\n")) - (start (save-excursion - (goto-char bol) - ;; FIXME: will incorrectly find a <<EOF embedded inside - ;; the heredoc. - (re-search-backward (concat sre "\\|" ere) nil t)))) - ;; If subgroup 1 matched, we found an open-heredoc, otherwise we first - ;; found a close-heredoc which makes the current close-heredoc inoperant. - (cond - ((when (and start (match-end 1) - (not (and indented (= (match-beginning 1) (match-end 1)))) - (not (sh-in-comment-or-string (match-beginning 0)))) - ;; Make sure our `<<' is not the EOF1 of a `cat <<EOF1 <<EOF2'. - (save-excursion - (goto-char start) - (setq start (line-beginning-position 2)) - (while - (progn - (re-search-forward "<<") ; Skip ourselves. - (and (re-search-forward sh-here-doc-open-re start 'move) - (goto-char (match-beginning 0)) - (sh-in-comment-or-string (point))))) - ;; No <<EOF2 found after our <<. - (= (point) start))) - (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax)) - ((not (or start (save-excursion (re-search-forward sre nil t)))) - ;; There's no <<EOF either before or after us, - ;; so we should remove ourselves from font-lock's keywords. - (setq sh-here-doc-markers (delete eof sh-here-doc-markers)) - (setq sh-here-doc-re - (concat sh-here-doc-open-re "\\|^\\([ \t]*\\)" - (regexp-opt sh-here-doc-markers t) "\\(\n\\)")) - nil)))) +(eval-and-compile + (defconst sh-escaped-line-re + ;; Should match until the real end-of-continued-line, but if that is not + ;; possible (because we bump into EOB or the search bound), then we should + ;; match until the search bound. + "\\(?:\\(?:.*[^\\\n]\\)?\\(?:\\\\\\\\\\)*\\\\\n\\)*.*") + + (defconst sh-here-doc-open-re + (concat "<<-?\\s-*\\\\?\\(\\(?:['\"][^'\"]+['\"]\\|\\sw\\|[-/~._]\\)+\\)" + sh-escaped-line-re "\\(\n\\)"))) (defun sh-font-lock-open-heredoc (start string eol) "Determine the syntax of the \\n after a <<EOF. @@ -996,27 +947,35 @@ Point is at the beginning of the next line." (sh-in-comment-or-string start)) ;; We're looking at <<STRING, so we add "^STRING$" to the syntactic ;; font-lock keywords to detect the end of this here document. - (let ((str (replace-regexp-in-string "['\"]" "" string))) - (unless (member str sh-here-doc-markers) - (push str sh-here-doc-markers) - (setq sh-here-doc-re - (concat sh-here-doc-open-re "\\|^\\([ \t]*\\)" - (regexp-opt sh-here-doc-markers t) "\\(\n\\)")))) - (let ((ppss (save-excursion (syntax-ppss (1- (point)))))) + (let ((str (replace-regexp-in-string "['\"]" "" string)) + (ppss (save-excursion (syntax-ppss eol)))) (if (nth 4 ppss) ;; The \n not only starts the heredoc but also closes a comment. ;; Let's close the comment just before the \n. - (put-text-property (1- (point)) (point) 'syntax-table '(12))) ;">" - (if (or (nth 5 ppss) (> (count-lines start (point)) 1)) - ;; If the sh-escaped-line-re part of sh-here-doc-re has matched + (put-text-property (1- eol) eol 'syntax-table '(12))) ;">" + (if (or (nth 5 ppss) (> (count-lines start eol) 1)) + ;; If the sh-escaped-line-re part of sh-here-doc-open-re has matched ;; several lines, make sure we refontify them together. ;; Furthermore, if (nth 5 ppss) is non-nil (i.e. the \n is ;; escaped), it means the right \n is actually further down. ;; Don't bother fixing it now, but place a multiline property so ;; that when jit-lock-context-* refontifies the rest of the ;; buffer, it also refontifies the current line with it. - (put-text-property start (point) 'syntax-multiline t))) - (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax))) + (put-text-property start (1+ eol) 'syntax-multiline t)) + (put-text-property eol (1+ eol) 'sh-here-doc-marker str) + (prog1 sh-here-doc-syntax + (goto-char (+ 2 start)))))) + +(defun sh-syntax-propertize-here-doc (end) + (let ((ppss (syntax-ppss))) + (when (eq t (nth 3 ppss)) + (let ((key (get-text-property (nth 8 ppss) 'sh-here-doc-marker))) + (when (re-search-forward + (concat "^\\([ \t]*\\)" (regexp-quote key) "\\(\n\\)") + end 'move) + (let ((eol (match-beginning 2))) + (put-text-property eol (1+ eol) + 'syntax-table sh-here-doc-syntax))))))) (defun sh-font-lock-quoted-subshell (limit) "Search for a subshell embedded in a string. @@ -1068,19 +1027,25 @@ subshells can nest." (not (sh-is-quoted-p (1- pos))))) (defun sh-font-lock-paren (start) + (unless (nth 8 (syntax-ppss)) (save-excursion (goto-char start) ;; Skip through all patterns (while (progn + (while + (progn (forward-comment (- (point-max))) + (when (and (eolp) (sh-is-quoted-p (point))) + (forward-char -1) + t))) ;; Skip through one pattern (while (or (/= 0 (skip-syntax-backward "w_")) - (/= 0 (skip-chars-backward "?[]*@/\\")) + (/= 0 (skip-chars-backward "-$=?[]*@/\\\\")) (and (sh-is-quoted-p (1- (point))) (goto-char (- (point) 2))) - (when (memq (char-before) '(?\" ?\')) + (when (memq (char-before) '(?\" ?\' ?\})) (condition-case nil (progn (backward-sexp 1) t) (error nil))))) ;; Patterns can be preceded by an open-paren (Bug#1320). @@ -1093,9 +1058,6 @@ subshells can nest." (backward-char 1)) (when (eq (char-before) ?|) (backward-char 1) t))) - ;; FIXME: ";; esac )" is a case that looks like a case-pattern but it's - ;; really just a close paren after a case statement. I.e. if we skipped - ;; over `esac' just now, we're not looking at a case-pattern. (when (progn (backward-char 2) (if (> start (line-end-position)) (put-text-property (point) (1+ start) @@ -1104,8 +1066,13 @@ subshells can nest." ;; a normal command rather than the real `in' keyword. ;; I.e. we should look back to try and find the ;; corresponding `case'. - (looking-at ";;\\|in")) - sh-st-punc))) + (and (looking-at ";[;&]\\|in") + ;; ";; esac )" is a case that looks like a case-pattern + ;; but it's really just a close paren after a case + ;; statement. I.e. if we skipped over `esac' just now, + ;; we're not looking at a case-pattern. + (not (looking-at "..[ \t\n]+esac[^[:word:]_]")))) + sh-st-punc)))) (defun sh-font-lock-backslash-quote () (if (eq (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) ?\') @@ -1115,42 +1082,36 @@ subshells can nest." (defun sh-syntax-propertize-function (start end) (goto-char start) - (while (prog1 - (re-search-forward sh-here-doc-re end 'move) + (sh-syntax-propertize-here-doc end) + (funcall + (syntax-propertize-rules + (sh-here-doc-open-re + (2 (sh-font-lock-open-heredoc + (match-beginning 0) (match-string 1) (match-beginning 2)))) + ("\\s|" (0 (prog1 nil (sh-syntax-propertize-here-doc end)))) + ;; A `#' begins a comment when it is unquoted and at the + ;; beginning of a word. In the shell, words are separated by + ;; metacharacters. 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 "_")) + ;; In a '...' the backslash is not escaping. + ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) + ;; Make sure $@ and $? are correctly recognized as sexps. + ("\\$\\([?@]\\)" (1 "_")) + ;; Distinguish the special close-paren in `case'. + (")" (0 (sh-font-lock-paren (match-beginning 0)))) + ;; Highlight (possibly nested) subshells inside "" quoted + ;; regions correctly. + ("\"\\(?:\\(?:[^\\\"]\\|\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" + (1 (ignore + ;; Save excursion because we want to also apply other + ;; syntax-propertize rules within the affected region. + (if (nth 8 (syntax-ppss)) + (goto-char (1+ (match-beginning 0))) (save-excursion - (save-match-data - (funcall - (syntax-propertize-rules - ;; A `#' begins a comment when it is unquoted and at the - ;; beginning of a word. In the shell, words are separated by - ;; metacharacters. 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 "_")) - ;; In a '...' the backslash is not escaping. - ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) - ;; Make sure $@ and $? are correctly recognized as sexps. - ("\\$\\([?@]\\)" (1 "_")) - ;; Distinguish the special close-paren in `case'. - (")" (0 (sh-font-lock-paren (match-beginning 0)))) - ;; Highlight (possibly nested) subshells inside "" quoted - ;; regions correctly. - ("\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" - (1 (ignore - ;; Save excursion because we want to also apply other - ;; syntax-propertize rules within the affected region. - (save-excursion - (sh-font-lock-quoted-subshell end)))))) - (prog1 start (setq start (point))) (point))))) - (if (match-beginning 2) - ;; FIXME: actually, once we see an heredoc opener, we should just - ;; search for its ender without propertizing anything in it. - (sh-font-lock-open-heredoc - (match-beginning 0) (match-string 1) (match-beginning 2)) - (sh-font-lock-close-heredoc - (match-beginning 0) (match-string 4) - (and (match-beginning 3) (/= (match-beginning 3) (match-end 3))) - (match-beginning 5))))) + (sh-font-lock-quoted-subshell end))))))) + (point) end)) (defun sh-font-lock-syntactic-face-function (state) (let ((q (nth 3 state))) @@ -1659,6 +1620,8 @@ This adds rules for comments and assignments." ("esac" sh-handle-this-esac sh-handle-prev-esac) (case-label nil sh-handle-after-case-label) ;; ??? (";;" nil sh-handle-prev-case-alt-end) ;; ??? + (";;&" nil sh-handle-prev-case-alt-end) ;Like ";;" with diff semantics. + (";&" nil sh-handle-prev-case-alt-end) ;Like ";;" with diff semantics. ("done" sh-handle-this-done sh-handle-prev-done) ("do" sh-handle-this-do sh-handle-prev-do)) @@ -2496,7 +2459,7 @@ we go to the end of the previous line and do not check for continuations." (sh-prev-line nil) (line-beginning-position)))) (skip-chars-backward " \t;" min-point) - (if (looking-at "\\s-*;;") + (if (looking-at "\\s-*;[;&]") ;; (message "Found ;; !") ";;" (skip-chars-backward "^)}];\"'`({[" min-point) diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index 608b266df8..14aee8c3ec 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -5,7 +5,6 @@ ;; 2008, 2009, 2010, 2011 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H14PRO021 - ;; Copyright (C) 2003 ;; National Institute of Advanced Industrial Science and Technology (AIST) ;; Registration Number H13PRO009 @@ -37,8 +36,7 @@ ;;; Code: -(eval-and-compile - (require 'ps-mule)) +(require 'ps-mule) ;;;###autoload (defcustom bdf-directory-list diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index 67c12b0054..7c974d3d3c 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -88,8 +88,7 @@ ;;; Code: -(eval-and-compile - (require 'ps-print)) +(require 'ps-print) ;;;###autoload diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 5432674410..19431c30d6 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -1479,7 +1479,7 @@ Please send all bug fixes and enhancements to ;; Load XEmacs/Emacs definitions -(eval-and-compile (require 'ps-def)) +(require 'ps-def) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -6657,7 +6657,7 @@ If FACE is not a valid face name, use default face." ;; But autoload them here to make the separation invisible. ;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize -;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "0e9db04f70d1221af96488068afa1192") +;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "14536f28e0dcaa956901bb59ad86a875") ;;; Generated autoloads from ps-mule.el (defvar ps-multibyte-buffer nil "\ diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el index d4d4124993..8b652b2608 100644 --- a/lisp/ps-samp.el +++ b/lisp/ps-samp.el @@ -34,7 +34,7 @@ ;;; Code: -(eval-and-compile (require 'ps-print)) +(require 'ps-print) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -254,9 +254,8 @@ (eval-when-compile (require 'cl)) -(eval-and-compile - (require 'printing) - (require 'zeroconf)) +(require 'printing) +(require 'zeroconf) ;; Add a Postscript printer to the "Postscript printer" menu. (defun ps-add-printer (service) diff --git a/lisp/replace.el b/lisp/replace.el index d89a511a09..0f8adea2ac 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -769,9 +769,6 @@ a previously found match." (define-key map "\M-p" 'occur-prev) (define-key map "r" 'occur-rename-buffer) (define-key map "c" 'clone-buffer) - (define-key map "g" 'revert-buffer) - (define-key map "q" 'quit-window) - (define-key map "z" 'kill-this-buffer) (define-key map "\C-c\C-f" 'next-error-follow-minor-mode) (define-key map [menu-bar] (make-sparse-keymap)) (define-key map [menu-bar occur] @@ -837,23 +834,17 @@ for this is to reveal context in an outline-mode when the occurrence is hidden." :group 'matching) (put 'occur-mode 'mode-class 'special) -(defun occur-mode () +(define-derived-mode occur-mode special-mode "Occur" "Major mode for output from \\[occur]. \\<occur-mode-map>Move point to one of the items in this buffer, then use \\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to. Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it. \\{occur-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map occur-mode-map) - (setq major-mode 'occur-mode) - (setq mode-name "Occur") (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) (make-local-variable 'occur-revert-arguments) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) - (setq next-error-function 'occur-next-error) - (run-mode-hooks 'occur-mode-hook)) + (setq next-error-function 'occur-next-error)) (defun occur-revert-function (ignore1 ignore2) "Handle `revert-buffer' for Occur mode buffers." diff --git a/lisp/server.el b/lisp/server.el index 1ee30f5bc3..79204b3cb8 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1,5 +1,4 @@ -;;; -*- lexical-binding: t -*- -;;; server.el --- Lisp code for GNU Emacs running as server process +;;; server.el --- Lisp code for GNU Emacs running as server process -*- lexical-binding: t -*- ;; Copyright (C) 1986-1987, 1992, 1994-2011 Free Software Foundation, Inc. @@ -937,126 +936,122 @@ The following commands are accepted by the client: tty-type ; string. files filepos - command-line-args-left - arg) + args-left) ;; Remove this line from STRING. (setq string (substring string (match-end 0))) - (setq command-line-args-left + (setq args-left (mapcar 'server-unquote-arg (split-string request " " t))) - (while (setq arg (pop command-line-args-left)) - (cond - ;; -version CLIENT-VERSION: obsolete at birth. - ((and (equal "-version" arg) command-line-args-left) - (pop command-line-args-left)) - - ;; -nowait: Emacsclient won't wait for a result. - ((equal "-nowait" arg) (setq nowait t)) - - ;; -current-frame: Don't create frames. - ((equal "-current-frame" arg) (setq use-current-frame t)) - - ;; -display DISPLAY: - ;; Open X frames on the given display instead of the default. - ((and (equal "-display" arg) command-line-args-left) - (setq display (pop command-line-args-left)) - (if (zerop (length display)) (setq display nil))) - - ;; -parent-id ID: - ;; Open X frame within window ID, via XEmbed. - ((and (equal "-parent-id" arg) command-line-args-left) - (setq parent-id (pop command-line-args-left)) - (if (zerop (length parent-id)) (setq parent-id nil))) - - ;; -window-system: Open a new X frame. - ((equal "-window-system" arg) - (setq dontkill t) - (setq tty-name 'window-system)) - - ;; -resume: Resume a suspended tty frame. - ((equal "-resume" arg) - (let ((terminal (process-get proc 'terminal))) - (setq dontkill t) - (push (lambda () - (when (eq (terminal-live-p terminal) t) - (resume-tty terminal))) - commands))) - - ;; -suspend: Suspend the client's frame. (In case we - ;; get out of sync, and a C-z sends a SIGTSTP to - ;; emacsclient.) - ((equal "-suspend" arg) - (let ((terminal (process-get proc 'terminal))) - (setq dontkill t) - (push (lambda () - (when (eq (terminal-live-p terminal) t) - (suspend-tty terminal))) - commands))) - - ;; -ignore COMMENT: Noop; useful for debugging emacsclient. - ;; (The given comment appears in the server log.) - ((and (equal "-ignore" arg) command-line-args-left - (setq dontkill t) - (pop command-line-args-left))) - - ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client. - ((and (equal "-tty" arg) - (cdr command-line-args-left)) - (setq tty-name (pop command-line-args-left) - tty-type (pop command-line-args-left) - dontkill (or dontkill - (not use-current-frame)))) - - ;; -position LINE[:COLUMN]: Set point to the given - ;; position in the next file. - ((and (equal "-position" arg) - command-line-args-left - (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" - (car command-line-args-left))) - (setq arg (pop command-line-args-left)) - (setq filepos - (cons (string-to-number (match-string 1 arg)) - (string-to-number (or (match-string 2 arg) ""))))) - - ;; -file FILENAME: Load the given file. - ((and (equal "-file" arg) - command-line-args-left) - (let ((file (pop command-line-args-left))) - (if coding-system - (setq file (decode-coding-string file coding-system))) - (setq file (expand-file-name file dir)) - (push (cons file filepos) files) - (server-log (format "New file: %s %s" - file (or filepos "")) proc)) - (setq filepos nil)) - - ;; -eval EXPR: Evaluate a Lisp expression. - ((and (equal "-eval" arg) - command-line-args-left) - (if use-current-frame - (setq use-current-frame 'always)) - (let ((expr (pop command-line-args-left))) - (if coding-system - (setq expr (decode-coding-string expr coding-system))) - (push (lambda () (server-eval-and-print expr proc)) - commands) - (setq filepos nil))) - - ;; -env NAME=VALUE: An environment variable. - ((and (equal "-env" arg) command-line-args-left) - (let ((var (pop command-line-args-left))) - ;; XXX Variables should be encoded as in getenv/setenv. - (process-put proc 'env - (cons var (process-get proc 'env))))) - - ;; -dir DIRNAME: The cwd of the emacsclient process. - ((and (equal "-dir" arg) command-line-args-left) - (setq dir (pop command-line-args-left)) - (if coding-system - (setq dir (decode-coding-string dir coding-system))) - (setq dir (command-line-normalize-file-name dir))) - - ;; Unknown command. - (t (error "Unknown command: %s" arg)))) + (while args-left + (pcase (pop args-left) + ;; -version CLIENT-VERSION: obsolete at birth. + (`"-version" (pop args-left)) + + ;; -nowait: Emacsclient won't wait for a result. + (`"-nowait" (setq nowait t)) + + ;; -current-frame: Don't create frames. + (`"-current-frame" (setq use-current-frame t)) + + ;; -display DISPLAY: + ;; Open X frames on the given display instead of the default. + (`"-display" + (setq display (pop args-left)) + (if (zerop (length display)) (setq display nil))) + + ;; -parent-id ID: + ;; Open X frame within window ID, via XEmbed. + (`"-parent-id" + (setq parent-id (pop args-left)) + (if (zerop (length parent-id)) (setq parent-id nil))) + + ;; -window-system: Open a new X frame. + (`"-window-system" + (setq dontkill t) + (setq tty-name 'window-system)) + + ;; -resume: Resume a suspended tty frame. + (`"-resume" + (let ((terminal (process-get proc 'terminal))) + (setq dontkill t) + (push (lambda () + (when (eq (terminal-live-p terminal) t) + (resume-tty terminal))) + commands))) + + ;; -suspend: Suspend the client's frame. (In case we + ;; get out of sync, and a C-z sends a SIGTSTP to + ;; emacsclient.) + (`"-suspend" + (let ((terminal (process-get proc 'terminal))) + (setq dontkill t) + (push (lambda () + (when (eq (terminal-live-p terminal) t) + (suspend-tty terminal))) + commands))) + + ;; -ignore COMMENT: Noop; useful for debugging emacsclient. + ;; (The given comment appears in the server log.) + (`"-ignore" + (setq dontkill t) + (pop args-left)) + + ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client. + (`"-tty" + (setq tty-name (pop args-left) + tty-type (pop args-left) + dontkill (or dontkill + (not use-current-frame)))) + + ;; -position LINE[:COLUMN]: Set point to the given + ;; position in the next file. + (`"-position" + (if (not (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" + (car args-left))) + (error "Invalid -position command in client args")) + (let ((arg (pop args-left))) + (setq filepos + (cons (string-to-number (match-string 1 arg)) + (string-to-number (or (match-string 2 arg) + "")))))) + + ;; -file FILENAME: Load the given file. + (`"-file" + (let ((file (pop args-left))) + (if coding-system + (setq file (decode-coding-string file coding-system))) + (setq file (expand-file-name file dir)) + (push (cons file filepos) files) + (server-log (format "New file: %s %s" + file (or filepos "")) proc)) + (setq filepos nil)) + + ;; -eval EXPR: Evaluate a Lisp expression. + (`"-eval" + (if use-current-frame + (setq use-current-frame 'always)) + (let ((expr (pop args-left))) + (if coding-system + (setq expr (decode-coding-string expr coding-system))) + (push (lambda () (server-eval-and-print expr proc)) + commands) + (setq filepos nil))) + + ;; -env NAME=VALUE: An environment variable. + (`"-env" + (let ((var (pop args-left))) + ;; XXX Variables should be encoded as in getenv/setenv. + (process-put proc 'env + (cons var (process-get proc 'env))))) + + ;; -dir DIRNAME: The cwd of the emacsclient process. + (`"-dir" + (setq dir (pop args-left)) + (if coding-system + (setq dir (decode-coding-string dir coding-system))) + (setq dir (command-line-normalize-file-name dir))) + + ;; Unknown command. + (arg (error "Unknown command: %s" arg)))) (setq frame (cond diff --git a/lisp/simple.el b/lisp/simple.el index 77d096fd79..456318de21 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -411,9 +411,11 @@ Other major modes are defined by comparison with this one." (define-key map " " 'scroll-up) (define-key map "\C-?" 'scroll-down) (define-key map "?" 'describe-mode) + (define-key map "h" 'describe-mode) (define-key map ">" 'end-of-buffer) (define-key map "<" 'beginning-of-buffer) (define-key map "g" 'revert-buffer) + (define-key map "z" 'kill-this-buffer) map)) (put 'special-mode 'mode-class 'special) @@ -5890,6 +5892,7 @@ With a prefix argument, set VARIABLE to VALUE buffer-locally." (define-key map [left] 'previous-completion) (define-key map [right] 'next-completion) (define-key map "q" 'quit-window) + (define-key map "z" 'kill-this-buffer) map) "Local map for completion list buffers.") diff --git a/lisp/strokes.el b/lisp/strokes.el index feeb8fec94..51e75c4387 100644 --- a/lisp/strokes.el +++ b/lisp/strokes.el @@ -718,6 +718,14 @@ Returns the corresponding match as (COMMAND . SCORE)." nil)) nil)) +(defsubst strokes-fill-current-buffer-with-whitespace () + "Erase the contents of the current buffer and fill it with whitespace." + (erase-buffer) + (loop repeat (frame-height) do + (insert-char ?\s (1- (frame-width))) + (newline)) + (goto-char (point-min))) + ;;;###autoload (defun strokes-read-stroke (&optional prompt event) "Read a simple stroke (interactively) and return the stroke. @@ -1034,15 +1042,7 @@ o Strokes are a bit computer-dependent in that they depend somewhat on (help-mode) (help-print-return-message))) -(defalias 'strokes-report-bug 'report-emacs-bug) - -(defsubst strokes-fill-current-buffer-with-whitespace () - "Erase the contents of the current buffer and fill it with whitespace." - (erase-buffer) - (loop repeat (frame-height) do - (insert-char ?\s (1- (frame-width))) - (newline)) - (goto-char (point-min))) +(define-obsolete-function-alias 'strokes-report-bug 'report-emacs-bug "24.1") (defun strokes-window-configuration-changed-p () "Non-nil if the `strokes-window-configuration' frame properties changed. diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el index fdac245c53..44908a87b8 100644 --- a/lisp/tar-mode.el +++ b/lisp/tar-mode.el @@ -220,7 +220,7 @@ Preserve the modified states of the buffers and set `buffer-swapped-with'." (defun tar-roundup-512 (s) "Round S up to the next multiple of 512." (ash (ash (+ s 511) -9) 9)) - + (defun tar-header-block-tokenize (pos coding) "Return a `tar-header' structure. This is a list of name, mode, uid, gid, size, @@ -283,7 +283,7 @@ write-date, checksum, link-type, and link-name." (let* ((size (tar-parse-octal-integer string tar-size-offset tar-time-offset)) ;; -1 so as to strip the terminating 0 byte. - (name (decode-coding-string + (name (decode-coding-string (buffer-substring pos (+ pos size -1)) coding)) (descriptor (tar-header-block-tokenize (+ pos (tar-roundup-512 size)) @@ -298,7 +298,7 @@ write-date, checksum, link-type, and link-name." (setf (tar-header-header-start descriptor) (copy-marker (- pos 512) t)) descriptor) - + (make-tar-header (copy-marker pos nil) name @@ -501,7 +501,7 @@ MODE should be an integer which is a file mode value." ;;(tar-header-block-check-checksum ;; hblock (tar-header-block-checksum hblock) ;; (tar-header-name descriptor)) - + (push descriptor result) (setq pos (tar-header-data-end descriptor)) (progress-reporter-update progress-reporter pos))) @@ -532,13 +532,11 @@ MODE should be an integer which is a file mode value." (define-key map "\C-m" 'tar-extract) (define-key map [mouse-2] 'tar-mouse-extract) (define-key map "g" 'revert-buffer) - (define-key map "h" 'describe-mode) (define-key map "n" 'tar-next-line) (define-key map "\^N" 'tar-next-line) (define-key map [down] 'tar-next-line) (define-key map "o" 'tar-extract-other-window) (define-key map "p" 'tar-previous-line) - (define-key map "q" 'quit-window) (define-key map "\^P" 'tar-previous-line) (define-key map [up] 'tar-previous-line) (define-key map "R" 'tar-rename-entry) @@ -614,7 +612,7 @@ MODE should be an integer which is a file mode value." (if (buffer-live-p tar-data-buffer) (kill-buffer tar-data-buffer))) ;;;###autoload -(define-derived-mode tar-mode nil "Tar" +(define-derived-mode tar-mode special-mode "Tar" "Major mode for viewing a tar file as a dired-like listing of its contents. You can move around using the usual cursor motion commands. Letters no longer insert themselves. diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el index 23f4d0dbd2..e1da0f6f1d 100644 --- a/lisp/term/lk201.el +++ b/lisp/term/lk201.el @@ -1,75 +1,77 @@ ;; -*- no-byte-compile: t -*- ;; Define function key sequences for DEC terminals. -(defvar lk201-function-map (make-sparse-keymap) - "Function key definitions for DEC terminals.") +(defvar lk201-function-map + (let ((map (make-sparse-keymap))) -;; Termcap or terminfo should set these. -;; (define-key lk201-function-map "\e[A" [up]) -;; (define-key lk201-function-map "\e[B" [down]) -;; (define-key lk201-function-map "\e[C" [right]) -;; (define-key lk201-function-map "\e[D" [left]) + ;; Termcap or terminfo should set these. + ;; (define-key map "\e[A" [up]) + ;; (define-key map "\e[B" [down]) + ;; (define-key map "\e[C" [right]) + ;; (define-key map "\e[D" [left]) -(define-key lk201-function-map "\e[1~" [find]) -(define-key lk201-function-map "\e[2~" [insert]) -(define-key lk201-function-map "\e[3~" [delete]) -(define-key lk201-function-map "\e[4~" [select]) -(define-key lk201-function-map "\e[5~" [prior]) -(define-key lk201-function-map "\e[6~" [next]) -(define-key lk201-function-map "\e[11~" [f1]) -(define-key lk201-function-map "\e[12~" [f2]) -(define-key lk201-function-map "\e[13~" [f3]) -(define-key lk201-function-map "\e[14~" [f4]) -(define-key lk201-function-map "\e[15~" [f5]) -(define-key lk201-function-map "\e[17~" [f6]) -(define-key lk201-function-map "\e[18~" [f7]) -(define-key lk201-function-map "\e[19~" [f8]) -(define-key lk201-function-map "\e[20~" [f9]) -(define-key lk201-function-map "\e[21~" [f10]) -;; Customarily F11 is used as the ESC key. -;; The file that includes this one, takes care of that. -(define-key lk201-function-map "\e[23~" [f11]) -(define-key lk201-function-map "\e[24~" [f12]) -(define-key lk201-function-map "\e[25~" [f13]) -(define-key lk201-function-map "\e[26~" [f14]) -(define-key lk201-function-map "\e[28~" [help]) -(define-key lk201-function-map "\e[29~" [menu]) -(define-key lk201-function-map "\e[31~" [f17]) -(define-key lk201-function-map "\e[32~" [f18]) -(define-key lk201-function-map "\e[33~" [f19]) -(define-key lk201-function-map "\e[34~" [f20]) + (define-key map "\e[1~" [find]) + (define-key map "\e[2~" [insert]) + (define-key map "\e[3~" [delete]) + (define-key map "\e[4~" [select]) + (define-key map "\e[5~" [prior]) + (define-key map "\e[6~" [next]) + (define-key map "\e[11~" [f1]) + (define-key map "\e[12~" [f2]) + (define-key map "\e[13~" [f3]) + (define-key map "\e[14~" [f4]) + (define-key map "\e[15~" [f5]) + (define-key map "\e[17~" [f6]) + (define-key map "\e[18~" [f7]) + (define-key map "\e[19~" [f8]) + (define-key map "\e[20~" [f9]) + (define-key map "\e[21~" [f10]) + ;; Customarily F11 is used as the ESC key. + ;; The file that includes this one, takes care of that. + (define-key map "\e[23~" [f11]) + (define-key map "\e[24~" [f12]) + (define-key map "\e[25~" [f13]) + (define-key map "\e[26~" [f14]) + (define-key map "\e[28~" [help]) + (define-key map "\e[29~" [menu]) + (define-key map "\e[31~" [f17]) + (define-key map "\e[32~" [f18]) + (define-key map "\e[33~" [f19]) + (define-key map "\e[34~" [f20]) -;; Termcap or terminfo should set these. -;; (define-key lk201-function-map "\eOA" [up]) -;; (define-key lk201-function-map "\eOB" [down]) -;; (define-key lk201-function-map "\eOC" [right]) -;; (define-key lk201-function-map "\eOD" [left]) + ;; Termcap or terminfo should set these. + ;; (define-key map "\eOA" [up]) + ;; (define-key map "\eOB" [down]) + ;; (define-key map "\eOC" [right]) + ;; (define-key map "\eOD" [left]) -;; Termcap or terminfo should set these, but doesn't properly. -;; Termcap sets these to k1-k4, which get mapped to f1-f4 in term.c -(define-key lk201-function-map "\eOP" [kp-f1]) -(define-key lk201-function-map "\eOQ" [kp-f2]) -(define-key lk201-function-map "\eOR" [kp-f3]) -(define-key lk201-function-map "\eOS" [kp-f4]) + ;; Termcap or terminfo should set these, but doesn't properly. + ;; Termcap sets these to k1-k4, which get mapped to f1-f4 in term.c + (define-key map "\eOP" [kp-f1]) + (define-key map "\eOQ" [kp-f2]) + (define-key map "\eOR" [kp-f3]) + (define-key map "\eOS" [kp-f4]) -(define-key lk201-function-map "\eOI" [kp-tab]) -(define-key lk201-function-map "\eOj" [kp-multiply]) -(define-key lk201-function-map "\eOk" [kp-add]) -(define-key lk201-function-map "\eOl" [kp-separator]) -(define-key lk201-function-map "\eOM" [kp-enter]) -(define-key lk201-function-map "\eOm" [kp-subtract]) -(define-key lk201-function-map "\eOn" [kp-decimal]) -(define-key lk201-function-map "\eOo" [kp-divide]) -(define-key lk201-function-map "\eOp" [kp-0]) -(define-key lk201-function-map "\eOq" [kp-1]) -(define-key lk201-function-map "\eOr" [kp-2]) -(define-key lk201-function-map "\eOs" [kp-3]) -(define-key lk201-function-map "\eOt" [kp-4]) -(define-key lk201-function-map "\eOu" [kp-5]) -(define-key lk201-function-map "\eOv" [kp-6]) -(define-key lk201-function-map "\eOw" [kp-7]) -(define-key lk201-function-map "\eOx" [kp-8]) -(define-key lk201-function-map "\eOy" [kp-9]) + (define-key map "\eOI" [kp-tab]) + (define-key map "\eOj" [kp-multiply]) + (define-key map "\eOk" [kp-add]) + (define-key map "\eOl" [kp-separator]) + (define-key map "\eOM" [kp-enter]) + (define-key map "\eOm" [kp-subtract]) + (define-key map "\eOn" [kp-decimal]) + (define-key map "\eOo" [kp-divide]) + (define-key map "\eOp" [kp-0]) + (define-key map "\eOq" [kp-1]) + (define-key map "\eOr" [kp-2]) + (define-key map "\eOs" [kp-3]) + (define-key map "\eOt" [kp-4]) + (define-key map "\eOu" [kp-5]) + (define-key map "\eOv" [kp-6]) + (define-key map "\eOw" [kp-7]) + (define-key map "\eOx" [kp-8]) + (define-key map "\eOy" [kp-9]) + map) + "Function key definitions for DEC terminals.") (defun terminal-init-lk201 () ;; Use inheritance to let the main keymap override these defaults. diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 6286b83258..712929ecec 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -487,7 +487,9 @@ unless the current buffer is a scratch buffer." (defun ns-find-file () "Do a `find-file' with the `ns-input-file' as argument." (interactive) - (let* ((f (file-truename (pop ns-input-file))) + (let* ((f (file-truename + (expand-file-name (pop ns-input-file) + command-line-default-directory))) (file (find-file-noselect f)) (bufwin1 (get-buffer-window file 'visible)) (bufwin2 (get-buffer-window "*scratch*" 'visibile))) diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el index 0ddf7b3e54..f1385a9645 100644 --- a/lisp/term/w32-win.el +++ b/lisp/term/w32-win.el @@ -186,6 +186,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (error "Suspending an Emacs running under W32 makes no sense")) (defvar dynamic-library-alist) +(defvar libpng-version) ; image.c #ifdef HAVE_NTGUI ;;; Set default known names for external libraries (setq dynamic-library-alist diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el index 728f42779b..17ddd1de95 100644 --- a/lisp/textmodes/bib-mode.el +++ b/lisp/textmodes/bib-mode.el @@ -47,11 +47,14 @@ :type 'file :group 'bib) -(defvar bib-mode-map (copy-keymap text-mode-map)) -(define-key bib-mode-map "\C-M" 'return-key-bib) -(define-key bib-mode-map "\C-c\C-u" 'unread-bib) -(define-key bib-mode-map "\C-c\C-@" 'mark-bib) -(define-key bib-mode-map "\e`" 'abbrev-mode) +(defvar bib-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map text-mode-map) + (define-key map "\C-M" 'return-key-bib) + (define-key map "\C-c\C-u" 'unread-bib) + (define-key map "\C-c\C-@" 'mark-bib) + (define-key map "\e`" 'abbrev-mode) + map)) (defun addbib () "Set up editor to add to troff bibliography file specified diff --git a/lisp/textmodes/enriched.el b/lisp/textmodes/enriched.el index f6677bf458..357b9d6c94 100644 --- a/lisp/textmodes/enriched.el +++ b/lisp/textmodes/enriched.el @@ -164,6 +164,24 @@ The value is a list of \(VAR VALUE VAR VALUE...).") (defvar enriched-rerun-flag nil) ;;; +;;; Keybindings +;;; + +(defvar enriched-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [remap move-beginning-of-line] 'beginning-of-line-text) + (define-key map "\C-m" 'reindent-then-newline-and-indent) + (define-key map + [remap newline-and-indent] 'reindent-then-newline-and-indent) + (define-key map "\M-j" 'facemenu-justification-menu) + (define-key map "\M-S" 'set-justification-center) + (define-key map "\C-x\t" 'increase-left-margin) + (define-key map "\C-c[" 'set-left-margin) + (define-key map "\C-c]" 'set-right-margin) + map) + "Keymap for Enriched mode.") + +;;; ;;; Define the mode ;;; @@ -184,6 +202,8 @@ Commands: :group 'enriched :lighter " Enriched" (cond ((null enriched-mode) ;; Turn mode off + (remove-hook 'change-major-mode-hook + 'enriched-before-change-major-mode 'local) (setq buffer-file-format (delq 'text/enriched buffer-file-format)) ;; restore old variable values (while enriched-old-bindings @@ -199,6 +219,8 @@ Commands: nil) (t ; Turn mode on + (add-hook 'change-major-mode-hook + 'enriched-before-change-major-mode nil 'local) (add-to-list 'buffer-file-format 'text/enriched) ;; Save old variable values before we change them. ;; These will be restored if we exit Enriched mode. @@ -226,8 +248,6 @@ Commands: (while enriched-old-bindings (set (pop enriched-old-bindings) (pop enriched-old-bindings))))) -(add-hook 'change-major-mode-hook 'enriched-before-change-major-mode) - (defun enriched-after-change-major-mode () (when enriched-mode (let ((enriched-rerun-flag t)) @@ -235,30 +255,8 @@ Commands: (add-hook 'after-change-major-mode-hook 'enriched-after-change-major-mode) -;;; -;;; Keybindings -;;; - -(defvar enriched-mode-map nil - "Keymap for Enriched mode.") -(if (null enriched-mode-map) - (fset 'enriched-mode-map (setq enriched-mode-map (make-sparse-keymap)))) - -(if (not (assq 'enriched-mode minor-mode-map-alist)) - (setq minor-mode-map-alist - (cons (cons 'enriched-mode enriched-mode-map) - minor-mode-map-alist))) - -(define-key enriched-mode-map [remap move-beginning-of-line] 'beginning-of-line-text) -(define-key enriched-mode-map "\C-m" 'reindent-then-newline-and-indent) -(define-key enriched-mode-map - [remap newline-and-indent] 'reindent-then-newline-and-indent) -(define-key enriched-mode-map "\M-j" 'facemenu-justification-menu) -(define-key enriched-mode-map "\M-S" 'set-justification-center) -(define-key enriched-mode-map "\C-x\t" 'increase-left-margin) -(define-key enriched-mode-map "\C-c[" 'set-left-margin) -(define-key enriched-mode-map "\C-c]" 'set-right-margin) +(fset 'enriched-mode-map enriched-mode-map) ;;; ;;; Some functions dealing with text-properties, especially indentation diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index a557f8d0e3..742a3cfb9b 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,9 @@ +2011-02-03 Lars Ingebrigtsen <[email protected]> + + * url-http.el (url-http-wait-for-headers-change-function): Don't + move point if the callback function has moved changed/killed the + process buffer. + 2010-12-16 Miles Bader <Miles Bader <[email protected]>> * url-cookie.el: Require 'cl when compiling -- it's necessary for diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index 7b82f11470..07e57cf330 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -1034,10 +1034,11 @@ the end of the document." url-http-response-status)) (url-http-debug "url-http-wait-for-headers-change-function (%s)" (buffer-name)) - (when (not (bobp)) - (let ((end-of-headers nil) - (old-http nil) - (content-length nil)) + (let ((end-of-headers nil) + (old-http nil) + (process-buffer (current-buffer)) + (content-length nil)) + (when (not (bobp)) (goto-char (point-min)) (if (and (looking-at ".*\n") ; have one line at least (not (looking-at "^HTTP/[1-9]\\.[0-9]"))) @@ -1151,8 +1152,9 @@ the end of the document." 'url-http-simple-after-change-function))))) ;; We are still at the beginning of the buffer... must just be ;; waiting for a response. - (url-http-debug "Spinning waiting for headers...")) - (goto-char (point-max))) + (url-http-debug "Spinning waiting for headers...") + (when (eq process-buffer (current-buffer)) + (goto-char (point-max))))) ;;;###autoload (defun url-http (url callback cbargs) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index a1c9f9d02d..13d10f02b4 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -140,9 +140,9 @@ when editing big diffs)." ;; Standard M-r is useful, so don't change M-r or M-R. ;;("r" . diff-restrict-view) ;;("R" . diff-reverse-direction) - ("g" . revert-buffer) - ("q" . quit-window)) - "Basic keymap for `diff-mode', bound to various prefix keys.") + ) + "Basic keymap for `diff-mode', bound to various prefix keys." + :inherit special-mode-map) (easy-mmode-defmap diff-mode-map `(("\e" . ,diff-mode-shared-map) diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 3b008c69d4..11ffc9a5e3 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -125,9 +125,12 @@ (require 'wid-edit) (easy-mmode-defmap log-view-mode-map - '(("z" . kill-this-buffer) + '( + ;; FIXME: (copy-keymap special-mode-map) instead + ("z" . kill-this-buffer) ("q" . quit-window) ("g" . revert-buffer) + ("m" . log-view-toggle-mark-entry) ("e" . log-view-modify-change-comment) ("d" . log-view-diff) diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 5f386bcee7..38fbaaedd3 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -1061,6 +1061,9 @@ Throw an error if another update process is in progress." (unless (vc-dir-fileinfo->directory info) (setf (vc-dir-fileinfo->needs-update info) t) nil)) vc-ewoc) + ;; Bzr has serious locking problems, so setup the headers first (this is + ;; synchronous) rather than doing it while dir-status is running. + (ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "") (lexical-let ((buffer (current-buffer))) (with-current-buffer vc-dir-process-buffer (cd def-dir) @@ -1081,8 +1084,7 @@ Throw an error if another update process is in progress." (vc-dir-refresh-files (mapcar 'vc-dir-fileinfo->name remaining) 'up-to-date) - (setq mode-line-process nil))))))))) - (ewoc-set-hf vc-ewoc (vc-dir-headers backend def-dir) "")))) + (setq mode-line-process nil)))))))))))) (defun vc-dir-show-fileentry (file) "Insert an entry for a specific file into the current *VC-dir* listing. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 7a0b8540ca..1034854435 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -662,8 +662,8 @@ This runs the command \"hg merge\"." (defun vc-hg-command (buffer okstatus file-or-list &rest flags) "A wrapper around `vc-do-command' for use in vc-hg.el. -The difference to vc-do-command is that this function always invokes `hg', -and that it passes `vc-hg-global-switches' to it before FLAGS." +This function differs from vc-do-command in that it invokes +`vc-hg-program', and passes `vc-hg-global-switches' to it before FLAGS." (apply 'vc-do-command (or buffer "*vc*") okstatus vc-hg-program file-or-list (if (stringp vc-hg-global-switches) (cons vc-hg-global-switches flags) |