diff options
Diffstat (limited to 'lisp')
63 files changed, 2883 insertions, 1197 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c0b00b8fbb1..e808cf75937 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,7 +1,318 @@ +2007-06-16 Karl Fogel <kfogel@red-bean.com> + + * thingatpt.el (thing-at-point-email-regexp): Don't require two + chars before the "@" in an email address. Andreas Roehler noticed + this problem. + +2007-06-15 Karl Fogel <kfogel@red-bean.com> + + * thingatpt.el: Add support for email addresses (`email'). + (thing-at-point, bounds-of-thing-at-point): Document `email' support. + (thing-at-point-email-regexp): New variable. + (`email'): Put `bounds-of-thing-at-point' and `thing-at-point' + properties on this symbol, with lambda forms for values. + +2007-06-15 Masatake YAMATO <jet@gyve.org> + + * vc-bzr.el (vc-bzr-root): Cache the output of shell command + execution. + + * vc.el (vc-dired-hook): Check the backend returned from + `vc-responsible-backend' can really handle `subdir'. + +2007-06-15 Chong Yidong <cyd@stupidchicken.com> + + * wid-edit.el (widget-add-documentation-string-button): Fix + handling of documentation indent. + +2007-06-15 Miles Bader <miles@fencepost.gnu.org> + + * mb-depth.el: New file. + +2007-06-15 Masatake YAMATO <jet@gyve.org> + + * vc.el (vc-dired-mode): Show backend name as part of mode name. + +2007-06-14 Chong Yidong <cyd@stupidchicken.com> + + * wid-edit.el (widget-default-create): Move ?h handling here... + (widget-default-format-handler): ...from here. + (widget-docstring, widget-add-documentation-string-button): New funs. + (documentation-string): Add :visibility-widget property. + (widget-documentation-string-value-create): Use it. + + * cus-edit.el (custom-split-regexp-maybe): Simplify. + (custom-buffer-create-internal): Simplify message. + (custom-variable-tag): Reduce height to normal. + (custom-variable-value-create, custom-face-value-create) + (custom-visibility): New widget. + (custom-visibility): New face. + (custom-group-value-create): Call + widget-add-documentation-string-button, using `custom-visibility'. + +2007-06-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/bytecomp.el (byte-compile-current-group) + (byte-compile-nogroup-warn, byte-compile-file): Revert part of last + change. Apparently the "warning even if the group is implicit" is + a feature rather than a bug. + +2007-06-14 Michael Kifer <kifer@cs.stonybrook.edu> + + * viper.el (viper-describe-key-ad, viper-describe-key-briefly-ad): + different advices for Emacs and XEmacs. Compile them conditionally. + (viper-version): belated version change. + +2007-06-14 Juanma Barranquero <lekktu@gmail.com> + + * follow.el (follow-all-followers, follow-generic-filter): + * pcomplete.el (pcomplete-restore-windows): + * x-dnd.el (x-dnd-maybe-call-test-function, x-dnd-save-state) + (x-dnd-drop-data): + * emacs-lisp/edebug.el (edebug-pop-to-buffer, edebug-display): + * progmodes/python.el (python-complete-symbol): + * term/mac-win.el (mac-dnd-drop-data): Remove redundant check. + +2007-06-13 Ryan Yeske <rcyeske@gmail.com> + + * rcirc.el (rcirc-format-response-string): Use rcirc-nick-syntax + around bright and dim regexps. Make sure bright and dim matches + use word anchors. Send text through rcirc-markup functions. + (rcirc-url-regexp): Add single quote character. + (rcirc-connect): Write logs to disk on auto-save-hook. + Make server a non-optional argument. + (rcirc-log-alist): New variable. + (rcirc-log-directory): Make customizable. + (rcirc-log-flag): New customizable variable. + (rcirc-log): New function. + (rcirc-print): Use above function. + (rcirc-log-write): New function. + (rcirc-generate-new-buffer-name): Strip text properties. + (rcirc-switch-to-buffer-function): Remove variable. + (rcirc-last-non-irc-buffer): Remove variable. + (rcirc-non-irc-buffer): Add function. + (rcirc-next-active-buffer): Use above function. + (rcirc-keepalive): Send KEEPALIVE ctcp instead of a PING. + (rcirc-handler-ctcp-KEEPALIVE): Add handler. + (rcirc-handler-CTCP): Don't print KEEPALIVE responses. + (rcirc-omit-mode): Add minor-mode. + (rcirc-mode-map): Change C-c C-o binding. + (rcirc-mode): Clear mode-line-process. Use a custom + fill-paragraph-function. Set up buffer-invisibility-spec. + (rcirc-response-formats): Remove timestamp code. + (rcirc-omit-responses): Add variable. + (rcirc-print): Don't put the overlay arrow on potentially omitted + lines. Log line to disk. Record activity for private messages + from /dim nicks. Facify the fill-prefix with rcirc-timestamp face. + (rcirc-jump-to-first-unread-line): Print message if there is no + unread text. + (rcirc-clear-unread): New function. + (rcirc-markup-text-functions): Add variable. + (rcirc-markup-timestamp, rcirc-markup-fill): Add functions. + (rcirc-debug): Don't mess with window configuration. + (rcirc-send-message): Send message before printing locally. + Add SILENT argument, do not print message if non-nil. + (rcirc-visible-buffers): New function and variable. + (rcirc-window-configuration-change-1): Add function. + (rcirc-target-buffer): Make sure ACTIONs don't get sent to the + server buffer. + (rcirc-clean-up-buffer): Set rcirc-target to nil when finished. + (rcirc-fill-paragraph): Add function. + (rcirc-record-activity, rcirc-window-configuration-change-1): + Only update the activity string if it has actually changed. + (rcirc-update-activity-string): Remove padding characters from the + mode-line string. + (rcirc-disconnect-buffer): New function to be called when a + channel is parted or the user quits. + (rcirc-server-name): Warn when the server-name hasn't been set. + (rcirc-window-configuration-change): Postpone work until + post-command-hook. + (rcirc-window-configuration-change-1): Update mode-line and + overlay arrows here. + (rcirc-authenticate): Fix chanserv identification. + (rcirc-default-server): Remove variable. + (rcirc): Connect according to rcirc-connections. + (rcirc-connections): Add variable. + (rcirc-startup-channels-alist): Remove variable. + (rcirc-startup-channels): Remove function. + +2007-06-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * diff-mode.el (diff-font-lock-keywords): Fix M. Kifer's last change. + +2007-06-13 Johan Bockg,Ae(Brd <bojohan@dd.chalmers.se> (tiny change) + + * term/xterm.el (terminal-init-xterm): Escape parens in character + constants. + +2007-06-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/sh-script.el: Remove unneeded * from docstrings. + Use [:alpha:] and [:alnum:] where applicable. + (sh-quoted-subshell): Rewrite to correctly + handle nested mixes of `...` and $(...). + (sh-apply-quoted-subshell): Remove. + (sh-font-lock-syntactic-keywords): Adjust call to sh-quoted-subshell. + + * vc-arch.el (vc-arch-command): Remove bzr. It's a different program. + +2007-06-12 Tom Tromey <tromey@redhat.com> + + * subr.el (user-emacs-directory): New defconst. + * cmuscheme.el (scheme-start-file): + * shell.el (shell): + * completion.el (save-completions-file-name): + * custom.el (custom-theme-directory): + * term/x-win.el (emacs-session-filename): + * filesets.el (filesets-menu-cache-file): + * thumbs.el (thumbs-thumbsdir): + * server.el (server-auth-dir): + * image-dired.el (image-dired-dir): + (image-dired-db-file): + (image-dired-temp-image-file): + (image-dired-gallery-dir): + (image-dired-temp-rotate-image-file): + * play/gamegrid.el (gamegrid-user-score-file-directory): + * savehist.el (savehist-file): + * tutorial.el (tutorial--saved-dir): + * startup.el (auto-save-list-file-prefix): Use user-emacs-directory. + +2007-06-12 Ralf Angeli <angeli@caeruleus.net> + + * scroll-lock.el (scroll-lock-mode): Doc fix. + +2007-06-12 Michael Kifer <kifer@cs.stonybrook.edu> + + * ediff-ptch.el (ediff-context-diff-label-regexp): Spurious parenthesis. + + * ediff-init.el: Doc strings. + +2007-06-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/bytecomp.el (byte-compile-current-group): New var. + (byte-compile-file): Bind it. + (byte-compile-nogroup-warn): Use it to avoid spurious warnings when the + group argument is provided implicitly. + (byte-compile-format-warn, byte-compile-from-buffer) + (byte-compile-insert-header): Don't hardcode point-min==1. + (byte-compile-file-form-require): Remove unused var old-load-list. + (byte-compile-eval): Remove unused vars old-autoloads and hist-nil-new. + +2007-06-12 Michael Kifer <kifer@cs.stonybrook.edu> + + * emulation/viper-cmd.el (viper-prefix-arg-com, viper-prefix-arg-value): + Display error messages. + (viper-prev-destructive-command, viper-insert-prev-from-insertion-ring): + Get rid of cl.el dependencies. + + * emulation/viper-init.el (viper-suppress-input-method-change-message): + New variable. + (viper-activate-input-method-action) + (viper-inactivate-input-method-action): + Use viper-suppress-input-method-change-message. + + * emulation/viper-kem.el (viper-vi-basic-map): Disable the bindings + for C-s, C-r. + + * emulation/viper-util.el (viper-set-cursor-color-according-to-state): + Use viper-replace-overlay-cursor-color instead of + viper-replace-overlay-cursor-color. + (viper-sit-for-short): Use sit-for with 3 arguments. + + * emulation/viper.el (viper-insert-state-mode-list): Add gud-mode. + (viper-major-mode-modifier-list): Add viper-comint-mode-modifier-map + to gud-mode. + + * ediff-mult.el (ediff-meta-buffer-brief-message) + (ediff-meta-buffer-verbose-message): New variables. + (ediff-meta-buffer-message): Variable deleted. + (ediff-verbose-help-enabled): New variable. + (ediff-toggle-verbose-help-meta-buffer): New function. + (ediff-redraw-directory-group-buffer): Made aware of short/verbose + message options + + * ediff-ptch.el (ediff-context-diff-label-regexp): Better regexp. + (ediff-fixup-patch-map): Improve heuristic. + +2007-06-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * log-view.el (log-view-file-re, log-view-message-re): Use \(?1:...\). + (log-view-font-lock-keywords): Simplify. + (log-view-current-file, log-view-current-tag): Simplify. + +2007-06-12 Sam Steingold <sds@gnu.org> + + * vc-arch.el (vc-arch-command): Also try "baz" and "bzr". + +2007-06-12 Juanma Barranquero <lekktu@gmail.com> + + * desktop.el (desktop-load-locked-desktop): New option. + (desktop-read): Use it. + (desktop-truncate, desktop-outvar, desktop-restore-file-buffer): + Use `when'. + +2007-06-12 Davis Herring <herring@lanl.gov> + + * desktop.el (desktop-save-mode-off): New function. + (desktop-base-lock-name, desktop-not-loaded-hook): New variables. + (desktop-full-lock-name, desktop-file-modtime, desktop-owner) + (desktop-claim-lock, desktop-release-lock): New functions. + (desktop-kill): Tell `desktop-save' that this is the last save. + Release the lock afterwards. + (desktop-buffer-info): New function. + (desktop-save): Use it. Run `desktop-save-hook' where the doc + says to. Detect conflicts, and manage the lock. + (desktop-read): Detect conflicts. Manage the lock. + +2007-06-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * emulation/tpu-mapper.el (tpu-emacs-map-key): Use new keymap names. + + * emulation/tpu-edt.el (tpu-gold-map): Rename from GOLD-map. + (tpu-lucid-emacs-p): Remove. Use (featurep 'xemacs) instead. + (CSI-map, GOLD-CSI-map, GOLD-SS3-map, SS3-map): Delete vars. + (tpu-gold-map, tpu-global-map): Add all the SS3 and CSI bindings, using + keysyms rather than byte sequences. + (tpu-copy-keyfile): Don't force the user to use tpu-mapper.el. + +2007-06-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * font-lock.el (font-lock-add-keywords): In case font-lock was only + half-activated, forcefully activate it completely. + +2007-06-11 Richard Stallman <rms@gnu.org> + + * cus-edit.el (custom-variable-type): Doc fix. + +2007-06-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/sh-script.el (sh-font-lock-backslash-quote) + (sh-font-lock-flush-syntax-ppss-cache): New functions. + (sh-font-lock-syntactic-keywords): Use them to distinguish the + different possible cases for \'. + + * complete.el (PC-bindings): Don't bind things already bound in the + parent keymap. + + * textmodes/bibtex-style.el: New file. + +2007-06-11 Riccardo Murri <riccardo.murri@gmail.com> + + * vc-bzr.el: New file. + +2007-06-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-svn.el (vc-svn-program): New var. + (vc-svn-command): Use it. + +2007-06-11 Juanma Barranquero <lekktu@gmail.com> + + * server.el (server-switch-buffer): Remove redundant check. + 2007-06-10 Martin Rudalics <rudalics@gmx.at> - * emacs-lisp/bytecomp.el (byte-compile-find-cl-functions): Match - against file-name-nondirectory. + * emacs-lisp/bytecomp.el (byte-compile-find-cl-functions): + Match against file-name-nondirectory. Fix text on user customization variables. Reported by Johan Bockg,Ae(Brd <bojohan@dd.chalmers.se>. diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el index 12840441a6a..b89470b0045 100644 --- a/lisp/cmuscheme.el +++ b/lisp/cmuscheme.el @@ -271,7 +271,7 @@ Search in the directories \"~\" and \"~/.emacs.d\", in this order. Return nil if no start file found." (let* ((progname (file-name-nondirectory prog)) (start-file (concat "~/.emacs_" progname)) - (alt-start-file (concat "~/.emacs.d/init_" progname ".scm"))) + (alt-start-file (concat user-emacs-directory "init_" progname ".scm"))) (if (file-exists-p start-file) start-file (and (file-exists-p alt-start-file) alt-start-file)))) diff --git a/lisp/complete.el b/lisp/complete.el index b1bb36f9dfa..7d9bd989089 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -153,11 +153,8 @@ If nil, means use the colon-separated path in the variable $INCPATH instead." (define-key completion-map " " 'minibuffer-complete-word) (define-key completion-map "?" 'minibuffer-completion-help) - (define-key must-match-map "\t" 'minibuffer-complete) - (define-key must-match-map " " 'minibuffer-complete-word) (define-key must-match-map "\r" 'minibuffer-complete-and-exit) (define-key must-match-map "\n" 'minibuffer-complete-and-exit) - (define-key must-match-map "?" 'minibuffer-completion-help) (define-key global-map [remap lisp-complete-symbol] nil)) (PC-default-bindings @@ -173,17 +170,11 @@ If nil, means use the colon-separated path in the variable $INCPATH instead." (define-key completion-map "\e\n" 'PC-force-complete-and-exit) (define-key completion-map "\e?" 'PC-completion-help) - (define-key must-match-map "\t" 'PC-complete) - (define-key must-match-map " " 'PC-complete-word) (define-key must-match-map "\r" 'PC-complete-and-exit) (define-key must-match-map "\n" 'PC-complete-and-exit) - (define-key must-match-map "?" 'PC-completion-help) - (define-key must-match-map "\e\t" 'PC-complete) - (define-key must-match-map "\e " 'PC-complete-word) (define-key must-match-map "\e\r" 'PC-complete-and-exit) (define-key must-match-map "\e\n" 'PC-complete-and-exit) - (define-key must-match-map "\e?" 'PC-completion-help) (define-key global-map [remap lisp-complete-symbol] 'PC-lisp-complete-symbol))))) diff --git a/lisp/completion.el b/lisp/completion.el index 25b95852536..c9e27ab3091 100644 --- a/lisp/completion.el +++ b/lisp/completion.el @@ -301,9 +301,9 @@ See also `save-completions-retention-time'." (let ((olddef (convert-standard-filename "~/.completions"))) (cond ((file-readable-p olddef) olddef) - ((file-directory-p (convert-standard-filename "~/.emacs.d/")) + ((file-directory-p user-emacs-directory) (convert-standard-filename - (expand-file-name "completions" "~/.emacs.d/"))) + (expand-file-name "completions" user-emacs-directory))) (t olddef))) "The filename to save completions to." :type 'file diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 4dae3bab018..9adb72c735c 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -501,17 +501,12 @@ (defun custom-split-regexp-maybe (regexp) "If REGEXP is a string, split it to a list at `\\|'. -You can get the original back with from the result with: +You can get the original back from the result with: (mapconcat 'identity result \"\\|\") IF REGEXP is not a string, return it unchanged." (if (stringp regexp) - (let ((start 0) - all) - (while (string-match "\\\\|" regexp start) - (setq all (cons (substring regexp start (match-beginning 0)) all) - start (match-end 0))) - (nreverse (cons (substring regexp start) all))) + (split-string regexp "\\\\|") regexp)) (defun custom-variable-prompt () @@ -1559,18 +1554,15 @@ Editing a setting changes only the text in the buffer." "Square brackets indicate"))) (if init-file-user (widget-insert " -Use the setting's State button to set it or save changes in it. -Saving a change normally works by editing your Emacs init file.") - (widget-insert " -\nSince you started Emacs with `-q', which inhibits use of the -Emacs init file, you cannot save settings into the Emacs init file.")) - (widget-insert "\nSee ") +Use the Save or Set buttons to set apply your changes. +Saving a change normally works by editing your Emacs ") + (widget-insert " +\nSince you started Emacs with `-q', you cannot save settings into +the Emacs ")) (widget-create 'custom-manual - :tag "Custom file" + :tag "init file" "(emacs)Saving Customizations") - (widget-insert - " for information on how to save in a different file.\n -See ") + (widget-insert ".\nSee ") (widget-create 'custom-manual :tag "Help" :help-echo "Read the online help." @@ -2439,13 +2431,13 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"." (defface custom-variable-tag `((((class color) (background dark)) - (:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch)) + (:foreground "light blue" :weight bold :inherit variable-pitch)) (((min-colors 88) (class color) (background light)) - (:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch)) + (:foreground "blue1" :weight bold :inherit variable-pitch)) (((class color) (background light)) - (:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch)) + (:foreground "blue" :weight bold :inherit variable-pitch)) (t (:weight bold))) "Face used for unpushable variable tags." :group 'custom-faces) @@ -2500,7 +2492,8 @@ However, setting it through Custom sets the default value.") (defun custom-variable-type (symbol) "Return a widget suitable for editing the value of SYMBOL. If SYMBOL has a `custom-type' property, use that. -Otherwise, look up symbol in `custom-guess-type-alist'." +Otherwise, try matching SYMBOL against `custom-guess-name-alist' and +try matching its doc string against `custom-guess-doc-alist'." (let* ((type (or (get symbol 'custom-type) (and (not (get symbol 'standard-value)) (custom-guess-type symbol)) @@ -2635,15 +2628,11 @@ Otherwise, look up symbol in `custom-guess-type-alist'." widget 'custom-magic nil))) (widget-put widget :custom-magic magic) (push magic buttons)) - ;; ### NOTE: this is ugly!!!! I need to update the :buttons property - ;; before the call to `widget-default-format-handler'. Otherwise, I - ;; loose my current `buttons'. This function shouldn't be called like - ;; this anyway. The doc string widget should be added like the others. - ;; --dv (widget-put widget :buttons buttons) (insert "\n") ;; Insert documentation. - (widget-default-format-handler widget ?h) + (widget-add-documentation-string-button + widget :visibility-widget 'custom-visibility) ;; The comment field (unless (eq state 'hidden) @@ -2983,6 +2972,21 @@ to switch between two values." ;; This call will possibly make the comment invisible (custom-redraw widget))) +;;; The `custom-visibility' Widget + +(define-widget 'custom-visibility 'visibility + "Show or hide a documentation string." + :button-face 'custom-visibility + :pressed-face 'custom-visibility + :mouse-face 'highlight + :pressed-face 'highlight) + +(defface custom-visibility + '((t :height 0.8 :inherit link)) + "Face for the `custom-visibility' widget." + :version "23.1" + :group 'custom-faces) + ;;; The `custom-face-edit' Widget. (define-widget 'custom-face-edit 'checklist @@ -3354,7 +3358,9 @@ SPEC must be a full face spec." ;; Update buttons. (widget-put widget :buttons buttons) ;; Insert documentation. - (widget-default-format-handler widget ?h) + (widget-add-documentation-string-button + widget :visibility-widget 'custom-visibility) + ;; The comment field (unless (eq state 'hidden) (let* ((comment (get symbol 'face-comment)) @@ -3926,7 +3932,9 @@ If GROUPS-ONLY non-nil, return only those members that are groups." ;; Insert documentation. (if (and (eq custom-buffer-style 'links) (> level 1)) (widget-put widget :documentation-indent 0)) - (widget-default-format-handler widget ?h)) + (widget-add-documentation-string-button + widget :visibility-widget 'custom-visibility)) + ;; Nested style. (t ;Visible. ;; Add parent groups references above the group. @@ -3934,7 +3942,7 @@ If GROUPS-ONLY non-nil, return only those members that are groups." ;;; was made to display a group. (when (eq level 1) (if (custom-add-parent-links widget - "Go to parent group:") + "Parent group:") (insert "\n")))) ;; Create level indicator. (insert-char ?\ (* custom-buffer-indent (1- level))) @@ -3970,7 +3978,9 @@ If GROUPS-ONLY non-nil, return only those members that are groups." ;; Update buttons. (widget-put widget :buttons buttons) ;; Insert documentation. - (widget-default-format-handler widget ?h) + (widget-add-documentation-string-button + widget :visibility-widget 'custom-visibility) + ;; Parent groups. (if nil ;;; This should test that the buffer ;;; was not made to display a group. diff --git a/lisp/custom.el b/lisp/custom.el index f5028ddc0d5..98a301d80f1 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -1009,10 +1009,7 @@ Every theme X has a property `provide-theme' whose value is \"X-theme\". ;;; Loading themes. (defcustom custom-theme-directory - (if (eq system-type 'ms-dos) - ;; MS-DOS cannot have initial dot. - "~/_emacs.d/" - "~/.emacs.d/") + user-emacs-directory "Directory in which Custom theme files should be written. `load-theme' searches this directory in addition to load-path. The command `customize-create-theme' writes the files it produces diff --git a/lisp/desktop.el b/lisp/desktop.el index e44e943db3e..191d1dbc291 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -162,6 +162,10 @@ and function `desktop-read' for details." (define-obsolete-variable-alias 'desktop-enable 'desktop-save-mode "22.1") +(defun desktop-save-mode-off () + "Disable `desktop-save-mode'. Provided for use in hooks." + (desktop-save-mode 0)) + (defcustom desktop-save 'ask-if-new "*Specifies whether the desktop should be saved when it is killed. A desktop is killed when the user changes desktop or quits Emacs. @@ -186,6 +190,22 @@ determine where the desktop is saved." :group 'desktop :version "22.1") +(defcustom desktop-load-locked-desktop 'ask + "Specifies whether the desktop should be loaded if locked. +Possible values are: + t -- load anyway. + nil -- don't load. + ask -- ask the user. +If the value is nil, or `ask' and the user chooses not to load the desktop, +the normal hook `desktop-not-loaded-hook' is run." + :type + '(choice + (const :tag "Load anyway" t) + (const :tag "Don't load" nil) + (const :tag "Ask the user" ask)) + :group 'desktop + :version "23.1") + (defcustom desktop-base-file-name (convert-standard-filename ".emacs.desktop") "Name of file for Emacs desktop, excluding the directory part." @@ -194,6 +214,13 @@ determine where the desktop is saved." (define-obsolete-variable-alias 'desktop-basefilename 'desktop-base-file-name "22.1") +(defcustom desktop-base-lock-name + (convert-standard-filename ".emacs.desktop.lock") + "Name of lock file for Emacs desktop, excluding the directory part." + :type 'file + :group 'desktop + :version "23.1") + (defcustom desktop-path '("." "~") "List of directories to search for the desktop file. The base name of the file is specified in `desktop-base-file-name'." @@ -219,6 +246,15 @@ May be used to show a dired buffer." :group 'desktop :version "22.1") +(defcustom desktop-not-loaded-hook nil + "Normal hook run when the user declines to re-use a desktop file. +Run in the directory in which the desktop file was found. +May be used to deal with accidental multiple Emacs jobs." + :type 'hook + :group 'desktop + :options '(desktop-save-mode-off save-buffers-kill-emacs) + :version "23.1") + (defcustom desktop-after-read-hook nil "Normal hook run after a successful `desktop-read'. May be used to show a buffer list." @@ -486,6 +522,11 @@ See also `desktop-minor-mode-table'.") DIRNAME omitted or nil means use `desktop-dirname'." (expand-file-name desktop-base-file-name (or dirname desktop-dirname))) +(defun desktop-full-lock-name (&optional dirname) + "Return the full name of the desktop lock file in DIRNAME. +DIRNAME omitted or nil means use `desktop-dirname'." + (expand-file-name desktop-base-lock-name (or dirname desktop-dirname))) + (defconst desktop-header ";; -------------------------------------------------------------------------- ;; Desktop File for Emacs @@ -496,11 +537,44 @@ DIRNAME omitted or nil means use `desktop-dirname'." "Hooks run after all buffers are loaded; intended for internal use.") ;; ---------------------------------------------------------------------------- +;; Desktop file conflict detection +(defvar desktop-file-modtime nil + "When the desktop file was last modified to the knowledge of this Emacs. +Used to detect desktop file conflicts.") + +(defun desktop-owner (&optional dirname) + "Return the PID of the Emacs process that owns the desktop file in DIRNAME. +Return nil if no desktop file found or no Emacs process is using it. +DIRNAME omitted or nil means use `desktop-dirname'." + (let (owner) + (and (file-exists-p (desktop-full-lock-name dirname)) + (condition-case nil + (with-temp-buffer + (insert-file-contents-literally (desktop-full-lock-name dirname)) + (goto-char (point-min)) + (setq owner (read (current-buffer))) + (integerp owner)) + (error nil)) + owner))) + +(defun desktop-claim-lock (&optional dirname) + "Record this Emacs process as the owner of the desktop file in DIRNAME. +DIRNAME omitted or nil means use `desktop-dirname'." + (write-region (number-to-string (emacs-pid)) nil + (desktop-full-lock-name dirname))) + +(defun desktop-release-lock (&optional dirname) + "Remove the lock file for the desktop in DIRNAME. +DIRNAME omitted or nil means use `desktop-dirname'." + (let ((file (desktop-full-lock-name dirname))) + (when (file-exists-p file) (delete-file file)))) + +;; ---------------------------------------------------------------------------- (defun desktop-truncate (list n) "Truncate LIST to at most N elements destructively." (let ((here (nthcdr (1- n) list))) - (if (consp here) - (setcdr here nil)))) + (when (consp here) + (setcdr here nil)))) ;; ---------------------------------------------------------------------------- ;;;###autoload @@ -513,7 +587,7 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'." (desktop-lazy-abort) (dolist (var desktop-globals-to-clear) (if (symbolp var) - (eval `(setq-default ,var nil)) + (eval `(setq-default ,var nil)) (eval `(setq-default ,(car var) ,(cdr var))))) (let ((buffers (buffer-list)) (preserve-regexp (concat "^\\(" @@ -556,10 +630,12 @@ is nil, ask the user where to save the desktop." (lambda (dir) (interactive "DDirectory for desktop file: ") dir)))))) (condition-case err - (desktop-save desktop-dirname) + (desktop-save desktop-dirname t) (file-error (unless (yes-or-no-p "Error while saving the desktop. Ignore? ") - (signal (car err) (cdr err))))))) + (signal (car err) (cdr err)))))) + ;; If we own it, we don't anymore. + (when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock))) ;; ---------------------------------------------------------------------------- (defun desktop-list* (&rest args) @@ -574,83 +650,123 @@ is nil, ask the user where to save the desktop." value))) ;; ---------------------------------------------------------------------------- +(defun desktop-buffer-info (buffer) + (set-buffer buffer) + (list + ;; basic information + (desktop-file-name (buffer-file-name) dirname) + (buffer-name) + major-mode + ;; minor modes + (let (ret) + (mapc + #'(lambda (minor-mode) + (and (boundp minor-mode) + (symbol-value minor-mode) + (let* ((special (assq minor-mode desktop-minor-mode-table)) + (value (cond (special (cadr special)) + ((functionp minor-mode) minor-mode)))) + (when value (add-to-list 'ret value))))) + (mapcar #'car minor-mode-alist)) + ret) + ;; point and mark, and read-only status + (point) + (list (mark t) mark-active) + buffer-read-only + ;; auxiliary information + (when (functionp desktop-save-buffer) + (funcall desktop-save-buffer dirname)) + ;; local variables + (let ((locals desktop-locals-to-save) + (loclist (buffer-local-variables)) + (ll)) + (while locals + (let ((here (assq (car locals) loclist))) + (if here + (setq ll (cons here ll)) + (when (member (car locals) loclist) + (setq ll (cons (car locals) ll))))) + (setq locals (cdr locals))) + ll))) + +;; ---------------------------------------------------------------------------- (defun desktop-internal-v2s (value) "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE. TXT is a string that when read and evaluated yields value. QUOTE may be `may' (value may be quoted), `must' (values must be quoted), or nil (value may not be quoted)." (cond - ((or (numberp value) (null value) (eq t value) (keywordp value)) - (cons 'may (prin1-to-string value))) - ((stringp value) - (let ((copy (copy-sequence value))) - (set-text-properties 0 (length copy) nil copy) - ;; Get rid of text properties because we cannot read them - (cons 'may (prin1-to-string copy)))) - ((symbolp value) - (cons 'must (prin1-to-string value))) - ((vectorp value) - (let* ((special nil) - (pass1 (mapcar - (lambda (el) - (let ((res (desktop-internal-v2s el))) - (if (null (car res)) - (setq special t)) - res)) - value))) - (if special - (cons nil (concat "(vector " - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - pass1 - " ") - ")")) - (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) - ((consp value) - (let ((p value) - newlist - use-list* - anynil) - (while (consp p) - (let ((q.txt (desktop-internal-v2s (car p)))) - (or anynil (setq anynil (null (car q.txt)))) - (setq newlist (cons q.txt newlist))) - (setq p (cdr p))) - (if p - (let ((last (desktop-internal-v2s p))) - (or anynil (setq anynil (null (car last)))) - (or anynil - (setq newlist (cons '(must . ".") newlist))) - (setq use-list* t) - (setq newlist (cons last newlist)))) - (setq newlist (nreverse newlist)) - (if anynil - (cons nil - (concat (if use-list* "(desktop-list* " "(list ") - (mapconcat (lambda (el) - (if (eq (car el) 'must) - (concat "'" (cdr el)) - (cdr el))) - newlist - " ") - ")")) - (cons 'must - (concat "(" (mapconcat 'cdr newlist " ") ")"))))) - ((subrp value) - (cons nil (concat "(symbol-function '" - (substring (prin1-to-string value) 7 -1) - ")"))) - ((markerp value) - (let ((pos (prin1-to-string (marker-position value))) - (buf (prin1-to-string (buffer-name (marker-buffer value))))) - (cons nil (concat "(let ((mk (make-marker)))" - " (add-hook 'desktop-delay-hook" - " (list 'lambda '() (list 'set-marker mk " - pos " (get-buffer " buf ")))) mk)")))) - (t ; save as text - (cons 'may "\"Unprintable entity\"")))) + ((or (numberp value) (null value) (eq t value) (keywordp value)) + (cons 'may (prin1-to-string value))) + ((stringp value) + (let ((copy (copy-sequence value))) + (set-text-properties 0 (length copy) nil copy) + ;; Get rid of text properties because we cannot read them + (cons 'may (prin1-to-string copy)))) + ((symbolp value) + (cons 'must (prin1-to-string value))) + ((vectorp value) + (let* ((special nil) + (pass1 (mapcar + (lambda (el) + (let ((res (desktop-internal-v2s el))) + (if (null (car res)) + (setq special t)) + res)) + value))) + (if special + (cons nil (concat "(vector " + (mapconcat (lambda (el) + (if (eq (car el) 'must) + (concat "'" (cdr el)) + (cdr el))) + pass1 + " ") + ")")) + (cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]"))))) + ((consp value) + (let ((p value) + newlist + use-list* + anynil) + (while (consp p) + (let ((q.txt (desktop-internal-v2s (car p)))) + (or anynil (setq anynil (null (car q.txt)))) + (setq newlist (cons q.txt newlist))) + (setq p (cdr p))) + (if p + (let ((last (desktop-internal-v2s p))) + (or anynil (setq anynil (null (car last)))) + (or anynil + (setq newlist (cons '(must . ".") newlist))) + (setq use-list* t) + (setq newlist (cons last newlist)))) + (setq newlist (nreverse newlist)) + (if anynil + (cons nil + (concat (if use-list* "(desktop-list* " "(list ") + (mapconcat (lambda (el) + (if (eq (car el) 'must) + (concat "'" (cdr el)) + (cdr el))) + newlist + " ") + ")")) + (cons 'must + (concat "(" (mapconcat 'cdr newlist " ") ")"))))) + ((subrp value) + (cons nil (concat "(symbol-function '" + (substring (prin1-to-string value) 7 -1) + ")"))) + ((markerp value) + (let ((pos (prin1-to-string (marker-position value))) + (buf (prin1-to-string (buffer-name (marker-buffer value))))) + (cons nil (concat "(let ((mk (make-marker)))" + " (add-hook 'desktop-delay-hook" + " (list 'lambda '() (list 'set-marker mk " + pos " (get-buffer " buf ")))) mk)")))) + (t ; save as text + (cons 'may "\"Unprintable entity\"")))) ;; ---------------------------------------------------------------------------- (defun desktop-value-to-string (value) @@ -676,17 +792,16 @@ which means to truncate VAR's value to at most MAX-SIZE elements (if (consp varspec) (setq var (car varspec) size (cdr varspec)) (setq var varspec)) - (if (boundp var) - (progn - (if (and (integerp size) - (> size 0) - (listp (eval var))) - (desktop-truncate (eval var) size)) - (insert "(setq " - (symbol-name var) - " " - (desktop-value-to-string (symbol-value var)) - ")\n"))))) + (when (boundp var) + (when (and (integerp size) + (> size 0) + (listp (eval var))) + (desktop-truncate (eval var) size)) + (insert "(setq " + (symbol-name var) + " " + (desktop-value-to-string (symbol-value var)) + ")\n")))) ;; ---------------------------------------------------------------------------- (defun desktop-save-buffer-p (filename bufname mode &rest dummy) @@ -724,90 +839,70 @@ DIRNAME must be the directory in which the desktop file will be saved." ;; ---------------------------------------------------------------------------- ;;;###autoload -(defun desktop-save (dirname) +(defun desktop-save (dirname &optional release) "Save the desktop in a desktop file. Parameter DIRNAME specifies where to save the desktop file. +Optional parameter RELEASE says whether we're done with this desktop. See also `desktop-base-file-name'." (interactive "DDirectory to save desktop file in: ") - (run-hooks 'desktop-save-hook) - (setq dirname (file-name-as-directory (expand-file-name dirname))) + (setq desktop-dirname (file-name-as-directory (expand-file-name dirname))) (save-excursion - (let ((filename (desktop-full-file-name dirname)) - (info - (mapcar - #'(lambda (b) - (set-buffer b) - (list - (desktop-file-name (buffer-file-name) dirname) - (buffer-name) - major-mode - ;; minor modes - (let (ret) - (mapc - #'(lambda (minor-mode) - (and - (boundp minor-mode) - (symbol-value minor-mode) - (let* ((special (assq minor-mode desktop-minor-mode-table)) - (value (cond (special (cadr special)) - ((functionp minor-mode) minor-mode)))) - (when value (add-to-list 'ret value))))) - (mapcar #'car minor-mode-alist)) - ret) - (point) - (list (mark t) mark-active) - buffer-read-only - ;; Auxiliary information - (when (functionp desktop-save-buffer) - (funcall desktop-save-buffer dirname)) - (let ((locals desktop-locals-to-save) - (loclist (buffer-local-variables)) - (ll)) - (while locals - (let ((here (assq (car locals) loclist))) - (if here - (setq ll (cons here ll)) - (when (member (car locals) loclist) - (setq ll (cons (car locals) ll))))) - (setq locals (cdr locals))) - ll))) - (buffer-list))) - (eager desktop-restore-eager)) - (with-temp-buffer - (insert - ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n" - desktop-header - ";; Created " (current-time-string) "\n" - ";; Desktop file format version " desktop-file-version "\n" - ";; Emacs version " emacs-version "\n\n" - ";; Global section:\n") - (dolist (varspec desktop-globals-to-save) - (desktop-outvar varspec)) - (if (memq 'kill-ring desktop-globals-to-save) - (insert - "(setq kill-ring-yank-pointer (nthcdr " - (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer))) - " kill-ring))\n")) - - (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n") - (dolist (l info) - (when (apply 'desktop-save-buffer-p l) - (insert "(" - (if (or (not (integerp eager)) - (unless (zerop eager) - (setq eager (1- eager)) - t)) - "desktop-create-buffer" - "desktop-append-buffer-args") - " " - desktop-file-version) - (dolist (e l) - (insert "\n " (desktop-value-to-string e))) - (insert ")\n\n"))) - (setq default-directory dirname) - (let ((coding-system-for-write 'emacs-mule)) - (write-region (point-min) (point-max) filename nil 'nomessage))))) - (setq desktop-dirname dirname)) + (let ((eager desktop-restore-eager) + (new-modtime (nth 5 (file-attributes (desktop-full-file-name))))) + (when + (or (not new-modtime) ; nothing to overwrite + (equal desktop-file-modtime new-modtime) + (yes-or-no-p (if desktop-file-modtime + (if (> (float-time new-modtime) (float-time desktop-file-modtime)) + "Desktop file is more recent than the one loaded. Save anyway? " + "Desktop file isn't the one loaded. Overwrite it? ") + "Current desktop was not loaded from a file. Overwrite this desktop file? ")) + (unless release (error "Desktop file conflict"))) + + ;; If we're done with it, release the lock. + ;; Otherwise, claim it if it's unclaimed or if we created it. + (if release + (desktop-release-lock) + (unless (and new-modtime (desktop-owner)) (desktop-claim-lock))) + + (with-temp-buffer + (insert + ";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n" + desktop-header + ";; Created " (current-time-string) "\n" + ";; Desktop file format version " desktop-file-version "\n" + ";; Emacs version " emacs-version "\n") + (save-excursion (run-hooks 'desktop-save-hook)) + (goto-char (point-max)) + (insert "\n;; Global section:\n") + (mapc (function desktop-outvar) desktop-globals-to-save) + (when (memq 'kill-ring desktop-globals-to-save) + (insert + "(setq kill-ring-yank-pointer (nthcdr " + (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer))) + " kill-ring))\n")) + + (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n") + (dolist (l (mapcar 'desktop-buffer-info (buffer-list))) + (when (apply 'desktop-save-buffer-p l) + (insert "(" + (if (or (not (integerp eager)) + (if (zerop eager) + nil + (setq eager (1- eager)))) + "desktop-create-buffer" + "desktop-append-buffer-args") + " " + desktop-file-version) + (dolist (e l) + (insert "\n " (desktop-value-to-string e))) + (insert ")\n\n"))) + + (setq default-directory dirname) + (let ((coding-system-for-write 'emacs-mule)) + (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage)) + ;; We remember when it was modified (which is presumably just now). + (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))))))) ;; ---------------------------------------------------------------------------- ;;;###autoload @@ -856,35 +951,56 @@ It returns t if a desktop file was loaded, nil otherwise." ;; Default: Home directory. "~")))) (if (file-exists-p (desktop-full-file-name)) - ;; Desktop file found, process it. - (let ((desktop-first-buffer nil) - (desktop-buffer-ok-count 0) - (desktop-buffer-fail-count 0) - ;; Avoid desktop saving during evaluation of desktop buffer. - (desktop-save nil)) - (desktop-lazy-abort) - ;; Evaluate desktop buffer. - (load (desktop-full-file-name) t t t) - ;; `desktop-create-buffer' puts buffers at end of the buffer list. - ;; We want buffers existing prior to evaluating the desktop (and not reused) - ;; to be placed at the end of the buffer list, so we move them here. - (mapc 'bury-buffer - (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list)))))) - (switch-to-buffer (car (buffer-list))) - (run-hooks 'desktop-delay-hook) - (setq desktop-delay-hook nil) - (run-hooks 'desktop-after-read-hook) - (message "Desktop: %d buffer%s restored%s%s." - desktop-buffer-ok-count - (if (= 1 desktop-buffer-ok-count) "" "s") - (if (< 0 desktop-buffer-fail-count) - (format ", %d failed to restore" desktop-buffer-fail-count) - "") - (if desktop-buffer-args-list - (format ", %d to restore lazily" - (length desktop-buffer-args-list)) - "")) - t) + ;; Desktop file found, but is it already in use? + (let ((desktop-first-buffer nil) + (desktop-buffer-ok-count 0) + (desktop-buffer-fail-count 0) + (owner (desktop-owner)) + ;; Avoid desktop saving during evaluation of desktop buffer. + (desktop-save nil)) + (if (and owner + (memq desktop-load-locked-desktop '(nil ask)) + (or (null desktop-load-locked-desktop) + (not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\ +Using it may cause conflicts. Use it anyway? " owner))))) + (progn + (setq desktop-dirname nil) + (let ((default-directory desktop-dirname)) + (run-hooks 'desktop-not-loaded-hook)) + (message "Desktop file in use; not loaded.")) + (desktop-lazy-abort) + ;; Evaluate desktop buffer and remember when it was modified. + (load (desktop-full-file-name) t t t) + (setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))) + ;; If it wasn't already, mark it as in-use, to bother other + ;; desktop instances. + (unless owner + (condition-case nil + (desktop-claim-lock) + (file-error (message "Couldn't record use of desktop file") + (sit-for 1)))) + + ;; `desktop-create-buffer' puts buffers at end of the buffer list. + ;; We want buffers existing prior to evaluating the desktop (and + ;; not reused) to be placed at the end of the buffer list, so we + ;; move them here. + (mapc 'bury-buffer + (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list)))))) + (switch-to-buffer (car (buffer-list))) + (run-hooks 'desktop-delay-hook) + (setq desktop-delay-hook nil) + (run-hooks 'desktop-after-read-hook) + (message "Desktop: %d buffer%s restored%s%s." + desktop-buffer-ok-count + (if (= 1 desktop-buffer-ok-count) "" "s") + (if (< 0 desktop-buffer-fail-count) + (format ", %d failed to restore" desktop-buffer-fail-count) + "") + (if desktop-buffer-args-list + (format ", %d to restore lazily" + (length desktop-buffer-args-list)) + "")) + t)) ;; No desktop file found. (desktop-clear) (let ((default-directory desktop-dirname)) @@ -946,28 +1062,28 @@ directory DIRNAME." desktop-buffer-name desktop-buffer-misc) "Restore a file buffer." - (if desktop-buffer-file-name - (if (or (file-exists-p desktop-buffer-file-name) - (let ((msg (format "Desktop: File \"%s\" no longer exists." - desktop-buffer-file-name))) - (if desktop-missing-file-warning - (y-or-n-p (concat msg " Re-create buffer? ")) - (message "%s" msg) - nil))) - (let* ((auto-insert nil) ; Disable auto insertion - (coding-system-for-read - (or coding-system-for-read - (cdr (assq 'buffer-file-coding-system - desktop-buffer-locals)))) - (buf (find-file-noselect desktop-buffer-file-name))) - (condition-case nil - (switch-to-buffer buf) - (error (pop-to-buffer buf))) - (and (not (eq major-mode desktop-buffer-major-mode)) - (functionp desktop-buffer-major-mode) - (funcall desktop-buffer-major-mode)) - buf) - nil))) + (when desktop-buffer-file-name + (if (or (file-exists-p desktop-buffer-file-name) + (let ((msg (format "Desktop: File \"%s\" no longer exists." + desktop-buffer-file-name))) + (if desktop-missing-file-warning + (y-or-n-p (concat msg " Re-create buffer? ")) + (message "%s" msg) + nil))) + (let* ((auto-insert nil) ; Disable auto insertion + (coding-system-for-read + (or coding-system-for-read + (cdr (assq 'buffer-file-coding-system + desktop-buffer-locals)))) + (buf (find-file-noselect desktop-buffer-file-name))) + (condition-case nil + (switch-to-buffer buf) + (error (pop-to-buffer buf))) + (and (not (eq major-mode desktop-buffer-major-mode)) + (functionp desktop-buffer-major-mode) + (funcall desktop-buffer-major-mode)) + buf) + nil))) (defun desktop-load-file (function) "Load the file where auto loaded FUNCTION is defined." @@ -1062,19 +1178,19 @@ directory DIRNAME." (error (message "%s" (error-message-string err)) 1)))) (when desktop-buffer-mark (if (consp desktop-buffer-mark) - (progn - (set-mark (car desktop-buffer-mark)) - (setq mark-active (car (cdr desktop-buffer-mark)))) + (progn + (set-mark (car desktop-buffer-mark)) + (setq mark-active (car (cdr desktop-buffer-mark)))) (set-mark desktop-buffer-mark))) ;; Never override file system if the file really is read-only marked. - (if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only)) + (when desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only)) (while desktop-buffer-locals (let ((this (car desktop-buffer-locals))) (if (consp this) - ;; an entry of this form `(symbol . value)' - (progn - (make-local-variable (car this)) - (set (car this) (cdr this))) + ;; an entry of this form `(symbol . value)' + (progn + (make-local-variable (car this)) + (set (car this) (cdr this))) ;; an entry of the form `symbol' (make-local-variable this) (makunbound this))) diff --git a/lisp/diff-mode.el b/lisp/diff-mode.el index 87fade841ca..973e387f230 100644 --- a/lisp/diff-mode.el +++ b/lisp/diff-mode.el @@ -338,7 +338,7 @@ when editing big diffs)." ("^--- .+ ----$" . diff-hunk-header-face) ;context ("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face) ;normal ("^---$" . diff-hunk-header-face) ;normal - ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\(\\S-+\\)\\(.*[^*-]\\)?\n" + ("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\([^ \t]+\\)\\(.*[^*-]\\)?\n" (0 diff-header-face) (2 diff-file-header-face prepend)) ("^\\([-<]\\)\\(.*\n\\)" (1 diff-indicator-removed-face) (2 diff-removed-face)) diff --git a/lisp/ediff-init.el b/lisp/ediff-init.el index d37096f9e89..8d05f2def09 100644 --- a/lisp/ediff-init.el +++ b/lisp/ediff-init.el @@ -102,7 +102,7 @@ that Ediff doesn't know about.") (boundp 'ediff-use-toolbar-p) ediff-use-toolbar-p)) ;Does the user want it ? -;; Defines SYMBOL as an advertised local variable. +;; Defines VAR as an advertised local variable. ;; Performs a defvar, then executes `make-variable-buffer-local' on ;; the variable. Also sets the `permanent-local' property, ;; so that `kill-all-local-variables' (called by major-mode setting @@ -110,6 +110,7 @@ that Ediff doesn't know about.") ;; ;; Plagiarised from `emerge-defvar-local' for XEmacs. (defmacro ediff-defvar-local (var value doc) + "Defines VAR as a local variable." (declare (indent defun)) `(progn (defvar ,var ,value ,doc) @@ -259,6 +260,7 @@ It needs to be killed when we quit the session.") ;; Doesn't save the point and mark. ;; This is `with-current-buffer' with the added test for live buffers." (defmacro ediff-with-current-buffer (buffer &rest body) + "Evaluates BODY in BUFFER." (declare (indent 1) (debug (form body))) `(if (ediff-buffer-live-p ,buffer) (save-current-buffer diff --git a/lisp/ediff-mult.el b/lisp/ediff-mult.el index 8fdd319746c..12dca168412 100644 --- a/lisp/ediff-mult.el +++ b/lisp/ediff-mult.el @@ -129,9 +129,15 @@ ;; the registry buffer (defvar ediff-registry-buffer nil) -(defconst ediff-meta-buffer-message "This is an Ediff Session Group Panel: %s +(defconst ediff-meta-buffer-brief-message "Ediff Session Group Panel: %s -Useful commands: + Type ? to show useful commands in this buffer + +") + +(defconst ediff-meta-buffer-verbose-message "Ediff Session Group Panel: %s + +Useful commands (type ? to hide them and free up screen): button2, v, or RET over session record: start that Ediff session M:\tin sessions invoked from here, brings back this group panel R:\tdisplay the registry of active Ediff sessions @@ -360,10 +366,24 @@ buffers." (if (stringp (ediff-get-session-objC-name session-info)) (file-directory-p (ediff-get-session-objC-name session-info)) t))) + +(ediff-defvar-local ediff-verbose-help-enabled nil + "If t, display redundant help in ediff-directories and other meta buffers. +Toggled by ediff-toggle-verbose-help-meta-buffer" ) + +;; Toggle verbose help in meta-buffers +;; TODO: Someone who understands all this can make it better. +(defun ediff-toggle-verbose-help-meta-buffer () + "Toggle showing tediously verbose help in meta buffers." + (interactive) + (setq ediff-verbose-help-enabled (not ediff-verbose-help-enabled)) + (ediff-update-meta-buffer (current-buffer) 'must-redraw)) + ;; set up the keymap in the meta buffer (defun ediff-setup-meta-map () (setq ediff-meta-buffer-map (make-sparse-keymap)) (suppress-keymap ediff-meta-buffer-map) + (define-key ediff-meta-buffer-map "?" 'ediff-toggle-verbose-help-meta-buffer) (define-key ediff-meta-buffer-map "q" 'ediff-quit-meta-buffer) (define-key ediff-meta-buffer-map "T" 'ediff-toggle-filename-truncation) (define-key ediff-meta-buffer-map "R" 'ediff-show-registry) @@ -924,27 +944,31 @@ behavior." (mapcar 'delete-overlay (overlays-in 1 1)) ; emacs ) - (insert (format ediff-meta-buffer-message - (ediff-abbrev-jobname ediff-metajob-name))) - (setq regexp (ediff-get-group-regexp meta-list) merge-autostore-dir (ediff-get-group-merge-autostore-dir meta-list)) - (cond ((ediff-collect-diffs-metajob) - (insert - " P:\tcollect custom diffs of all marked sessions\n")) - ((ediff-patch-metajob) - (insert - " P:\tshow patch appropriately for the context (session or group)\n"))) - (insert - " ^:\tshow parent session group\n") - (or (ediff-one-filegroup-metajob) - (insert - " D:\tshow differences among directories\n" - " ==:\tfor each session, show which files are identical\n" - " =h:\tlike ==, but also marks those sessions for hiding\n" - " =m:\tlike ==, but also marks those sessions for operation\n\n")) + (if ediff-verbose-help-enabled + (progn + (insert (format ediff-meta-buffer-verbose-message + (ediff-abbrev-jobname ediff-metajob-name))) + + (cond ((ediff-collect-diffs-metajob) + (insert + " P:\tcollect custom diffs of all marked sessions\n")) + ((ediff-patch-metajob) + (insert + " P:\tshow patch appropriately for the context (session or group)\n"))) + (insert + " ^:\tshow parent session group\n") + (or (ediff-one-filegroup-metajob) + (insert + " D:\tshow differences among directories\n" + " ==:\tfor each session, show which files are identical\n" + " =h:\tlike ==, but also marks sessions for hiding\n" + " =m:\tlike ==, but also marks sessions for operation\n\n"))) + (insert (format ediff-meta-buffer-brief-message + (ediff-abbrev-jobname ediff-metajob-name)))) (insert "\n") (if (and (stringp regexp) (> (length regexp) 0)) diff --git a/lisp/ediff-ptch.el b/lisp/ediff-ptch.el index c8a8b70f162..8c0be8b1c8d 100644 --- a/lisp/ediff-ptch.el +++ b/lisp/ediff-ptch.el @@ -134,11 +134,13 @@ patch. So, don't change these variables, unless the default doesn't work." :type '(choice (const nil) string) :group 'ediff-ptch) +;; This context diff does not recognize spaces inside files, but removing ' ' +;; from [^ \t] breaks normal patches for some reason (defcustom ediff-context-diff-label-regexp (concat "\\(" ; context diff 2-liner - "^\\*\\*\\* \\([^ \t]+\\)[^*]+[\t ]*\n--- \\([^ \t]+\\)" + "^\\*\\*\\* +\\([^ \t]+\\)[^*]+[\t ]*\n--- +\\([^ \t]+\\)" "\\|" ; GNU unified format diff 2-liner - "^--- \\([^ \t]+\\)[\t ]+.*\n\\+\\+\\+ \\([^ \t]+\\)" + "^--- +\\([^ \t]+\\)[\t ]+.*\n\\+\\+\\+ +\\([^ \t]+\\)" "\\)") "*Regexp matching filename 2-liners at the start of each context diff. You probably don't want to change that, unless you are using an obscure patch @@ -231,7 +233,7 @@ program." ;; possible-file-names is holding the new file names until we ;; insert the old file name in the patch map ;; It is a pair - ;; (filename-from-1st-header-line . fn from 2nd line) + ;; (filename-from-1st-header-line . filename-from-2nd-line) (setq possible-file-names (cons (if (and beg1 end1) (buffer-substring beg1 end1) @@ -309,12 +311,13 @@ program." ;; these dirs lead to the actual files starting at the present ;; directory. So, we don't strip these relative dirs from the ;; file names. This is a heuristic intended to improve guessing - (unless (or (file-name-absolute-p base-dir1) - (file-name-absolute-p base-dir2) - (not (file-exists-p base-dir1)) - (not (file-exists-p base-dir2))) - (setq base-dir1 "" - base-dir2 "")) + (let ((default-directory (file-name-directory filename))) + (unless (or (file-name-absolute-p base-dir1) + (file-name-absolute-p base-dir2) + (not (file-exists-p base-dir1)) + (not (file-exists-p base-dir2))) + (setq base-dir1 "" + base-dir2 ""))) (or (string= (car proposed-file-names) "/dev/null") (setcar proposed-file-names (ediff-file-name-sans-prefix diff --git a/lisp/ediff.el b/lisp/ediff.el index c5f5c48f8da..69717ca13ad 100644 --- a/lisp/ediff.el +++ b/lisp/ediff.el @@ -7,8 +7,8 @@ ;; Created: February 2, 1994 ;; Keywords: comparing, merging, patching, tools, unix -(defconst ediff-version "2.81.1" "The current version of Ediff") -(defconst ediff-date "October 23, 2006" "Date of last update") +(defconst ediff-version "2.81.2" "The current version of Ediff") +(defconst ediff-date "June 13, 2007" "Date of last update") ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 619b7533ca7..8760f36775b 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -853,13 +853,11 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (when (and (consp s) (eq t (car s))) (push (cdr s) old-autoloads))))))) (when (memq 'cl-functions byte-compile-warnings) - (let ((hist-new load-history) - (hist-nil-new current-load-list)) + (let ((hist-new load-history)) ;; Go through load-history, look for newly loaded files ;; and mark all the functions defined therein. (while (and hist-new (not (eq hist-new hist-orig))) - (let ((xs (pop hist-new)) - old-autoloads) + (let ((xs (pop hist-new))) ;; Make sure the file was not already loaded before. (when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig))) (byte-compile-find-cl-functions))))))))) @@ -1265,7 +1263,7 @@ extra args." (get (car form) 'byte-compile-format-like)) (let ((nfields (with-temp-buffer (insert (nth 1 form)) - (goto-char 1) + (goto-char (point-min)) (let ((n 0)) (while (re-search-forward "%." nil t) (unless (eq ?% (char-after (1+ (match-beginning 0)))) @@ -1283,19 +1281,19 @@ extra args." ;; Warn if a custom definition fails to specify :group. (defun byte-compile-nogroup-warn (form) (let ((keyword-args (cdr (cdr (cdr (cdr form))))) - (name (cadr form))) + (name (cadr form))) (or (not (eq (car-safe name) 'quote)) - (and (eq (car form) 'custom-declare-group) - (equal name ''emacs)) - (plist-get keyword-args :group) - (not (and (consp name) (eq (car name) 'quote))) - (byte-compile-warn - "%s for `%s' fails to specify containing group" - (cdr (assq (car form) - '((custom-declare-group . defgroup) - (custom-declare-face . defface) - (custom-declare-variable . defcustom)))) - (cadr name))))) + (and (eq (car form) 'custom-declare-group) + (equal name ''emacs)) + (plist-get keyword-args :group) + (not (and (consp name) (eq (car name) 'quote))) + (byte-compile-warn + "%s for `%s' fails to specify containing group" + (cdr (assq (car form) + '((custom-declare-group . defgroup) + (custom-declare-face . defface) + (custom-declare-variable . defcustom)))) + (cadr name))))) ;; Warn if the function or macro is being redefined with a different ;; number of arguments. @@ -1834,9 +1832,8 @@ With argument, insert value in current buffer after the form." ;; byte-compile-warnings)) ) (byte-compile-close-variables - (save-excursion - (setq outbuffer - (set-buffer (get-buffer-create " *Compiler Output*"))) + (with-current-buffer + (setq outbuffer (get-buffer-create " *Compiler Output*")) (set-buffer-multibyte t) (erase-buffer) ;; (emacs-lisp-mode) @@ -1850,9 +1847,8 @@ With argument, insert value in current buffer after the form." (setq overwrite-mode 'overwrite-mode-binary)) (displaying-byte-compile-warnings (and filename (byte-compile-insert-header filename inbuffer outbuffer)) - (save-excursion - (set-buffer inbuffer) - (goto-char 1) + (with-current-buffer inbuffer + (goto-char (point-min)) ;; Compile the forms from the input buffer. (while (progn @@ -1920,7 +1916,7 @@ With argument, insert value in current buffer after the form." (let ((dynamic-docstrings byte-compile-dynamic-docstrings) (dynamic byte-compile-dynamic)) (set-buffer outbuffer) - (goto-char 1) + (goto-char (point-min)) ;; The magic number of .elc files is ";ELC", or 0x3B454C43. After ;; that is the file-format version number (18, 19 or 20) as a ;; byte, followed by some nulls. The primary motivation for doing @@ -2241,8 +2237,7 @@ list that represents a doc string reference. (put 'require 'byte-hunk-handler 'byte-compile-file-form-require) (defun byte-compile-file-form-require (form) - (let ((old-load-list current-load-list) - (args (mapcar 'eval (cdr form)))) + (let ((args (mapcar 'eval (cdr form)))) (apply 'require args) ;; Detect (require 'cl) in a way that works even if cl is already loaded. (if (member (car args) '("cl" cl)) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 9ae33599f09..3d9e63bc802 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -369,7 +369,7 @@ Return the result of the last expression in BODY." ;; Otherwise, find a new window, possibly splitting one. (setq window (cond - ((and (windowp window) (edebug-window-live-p window) + ((and (edebug-window-live-p window) (eq (window-buffer window) buffer)) window) ((eq (window-buffer (selected-window)) buffer) @@ -2739,7 +2739,7 @@ MSG is printed after `::::} '." ;; Unrestore edebug-buffer's window-start, if displayed. (let ((window (car edebug-window-data))) - (if (and window (edebug-window-live-p window) + (if (and (edebug-window-live-p window) (eq (window-buffer) edebug-buffer)) (progn (set-window-start window (cdr edebug-window-data) diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el index 8d65a267c4e..68e1561ae4d 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/emulation/tpu-edt.el @@ -207,16 +207,16 @@ ;; ; The emacs universal-argument function is very useful. ;; ; This line maps universal-argument to Gold-PF1. -;; (define-key GOLD-SS3-map "P" 'universal-argument) ; Gold-PF1 +;; (define-key tpu-gold-map [kp_f1] 'universal-argument) ; Gold-PF1 ;; ; Make KP7 move by paragraphs, instead of pages. -;; (define-key SS3-map "w" 'tpu-paragraph) ; KP7 +;; (define-key tpu-global-map [kf_7] 'tpu-paragraph) ; KP7 ;; ; Repeat the preceding mappings for X-windows. ;; (cond ;; (window-system -;; (global-set-key [kp_7] 'tpu-paragraph) ; KP7 -;; (define-key GOLD-map [kp_f1] 'universal-argument))) ; GOLD-PF1 +;; (define-key tpu-global-map [kp_7] 'tpu-paragraph) ; KP7 +;; (define-key tpu-gold-map [kp_f1] 'universal-argument))) ; GOLD-PF1 ;; ; Display the TPU-edt version. ;; (tpu-version) @@ -292,146 +292,88 @@ ;;; User Configurable Variables ;;; (defcustom tpu-have-ispell t - "*If non-nil (default), TPU-edt uses ispell for spell checking." + "If non-nil (default), TPU-edt uses ispell for spell checking." :type 'boolean :group 'tpu) (defcustom tpu-kill-buffers-silently nil - "*If non-nil, TPU-edt kills modified buffers without asking." + "If non-nil, TPU-edt kills modified buffers without asking." :type 'boolean :group 'tpu) (defcustom tpu-percent-scroll 75 - "*Percentage of the screen to scroll for next/previous screen commands." + "Percentage of the screen to scroll for next/previous screen commands." :type 'integer :group 'tpu) (defcustom tpu-pan-columns 16 - "*Number of columns the tpu-pan functions scroll left or right." + "Number of columns the tpu-pan functions scroll left or right." :type 'integer :group 'tpu) ;;; -;;; Emacs version identifiers - currently referenced by -;;; -;;; o tpu-mark o tpu-set-mark -;;; o mode line section o tpu-load-xkeys -;;; -(defconst tpu-lucid-emacs-p - (string-match "Lucid" emacs-version) - "Non-nil if we are running Lucid Emacs.") - -;;; ;;; Global Keymaps ;;; -(defvar CSI-map - (let ((map (make-sparse-keymap))) - (define-key map "A" 'tpu-previous-line) ; up - (define-key map "B" 'tpu-next-line) ; down - (define-key map "D" 'tpu-backward-char) ; left - (define-key map "C" 'tpu-forward-char) ; right - - (define-key map "1~" 'tpu-search) ; Find - (define-key map "2~" 'tpu-paste) ; Insert Here - (define-key map "3~" 'tpu-cut) ; Remove - (define-key map "4~" 'tpu-select) ; Select - (define-key map "5~" 'tpu-scroll-window-down) ; Prev Screen - (define-key map "6~" 'tpu-scroll-window-up) ; Next Screen - - (define-key map "11~" 'nil) ; F1 - (define-key map "12~" 'nil) ; F2 - (define-key map "13~" 'nil) ; F3 - (define-key map "14~" 'nil) ; F4 - (define-key map "15~" 'nil) ; F5 - (define-key map "17~" 'nil) ; F6 - (define-key map "18~" 'nil) ; F7 - (define-key map "19~" 'nil) ; F8 - (define-key map "20~" 'nil) ; F9 - (define-key map "21~" 'tpu-exit) ; F10 - (define-key map "23~" 'tpu-insert-escape) ; F11 (ESC) - (define-key map "24~" 'tpu-next-beginning-of-line) ; F12 (BS) - (define-key map "25~" 'tpu-delete-previous-word) ; F13 (LF) - (define-key map "26~" 'tpu-toggle-overwrite-mode) ; F14 - (define-key map "28~" 'tpu-help) ; HELP - (define-key map "29~" 'execute-extended-command) ; DO - (define-key map "31~" 'tpu-goto-breadcrumb) ; F17 - (define-key map "32~" 'nil) ; F18 - (define-key map "33~" 'nil) ; F19 - (define-key map "34~" 'nil) ; F20 - map) - "Maps the CSI function keys on the VT100 keyboard. -CSI is DEC's name for the sequence <ESC>[.") -(defvar GOLD-CSI-map - (let ((map (make-sparse-keymap))) - (define-key map "A" 'tpu-move-to-beginning) ; up-arrow - (define-key map "B" 'tpu-move-to-end) ; down-arrow - (define-key map "C" 'end-of-line) ; right-arrow - (define-key map "D" 'beginning-of-line) ; left-arrow - - (define-key map "1~" 'nil) ; Find - (define-key map "2~" 'nil) ; Insert Here - (define-key map "3~" 'tpu-store-text) ; Remove - (define-key map "4~" 'tpu-unselect) ; Select - (define-key map "5~" 'tpu-previous-window) ; Prev Screen - (define-key map "6~" 'tpu-next-window) ; Next Screen - - (define-key map "11~" 'nil) ; F1 - (define-key map "12~" 'nil) ; F2 - (define-key map "13~" 'nil) ; F3 - (define-key map "14~" 'nil) ; F4 - (define-key map "16~" 'nil) ; F5 - (define-key map "17~" 'nil) ; F6 - (define-key map "18~" 'nil) ; F7 - (define-key map "19~" 'nil) ; F8 - (define-key map "20~" 'nil) ; F9 - (define-key map "21~" 'nil) ; F10 - (define-key map "23~" 'nil) ; F11 - (define-key map "24~" 'nil) ; F12 - (define-key map "25~" 'nil) ; F13 - (define-key map "26~" 'nil) ; F14 - (define-key map "28~" 'describe-bindings) ; HELP - (define-key map "29~" 'nil) ; DO - (define-key map "31~" 'tpu-drop-breadcrumb) ; F17 - (define-key map "32~" 'nil) ; F18 - (define-key map "33~" 'nil) ; F19 - (define-key map "34~" 'nil) ; F20 - map) - "Maps the function keys on the VT100 keyboard preceded by GOLD-CSI.") - -(defvar GOLD-SS3-map - (let ((map (make-sparse-keymap))) - (define-key map "A" 'tpu-move-to-beginning) ; up-arrow - (define-key map "B" 'tpu-move-to-end) ; down-arrow - (define-key map "C" 'end-of-line) ; right-arrow - (define-key map "D" 'beginning-of-line) ; left-arrow - - (define-key map "P" 'keyboard-quit) ; PF1 - (define-key map "Q" 'help-for-help) ; PF2 - (define-key map "R" 'tpu-search) ; PF3 - (define-key map "S" 'tpu-undelete-lines) ; PF4 - (define-key map "p" 'open-line) ; KP0 - (define-key map "q" 'tpu-change-case) ; KP1 - (define-key map "r" 'tpu-delete-to-eol) ; KP2 - (define-key map "s" 'tpu-special-insert) ; KP3 - (define-key map "t" 'tpu-move-to-end) ; KP4 - (define-key map "u" 'tpu-move-to-beginning) ; KP5 - (define-key map "v" 'tpu-paste) ; KP6 - (define-key map "w" 'execute-extended-command) ; KP7 - (define-key map "x" 'tpu-fill) ; KP8 - (define-key map "y" 'tpu-replace) ; KP9 - (define-key map "m" 'tpu-undelete-words) ; KP- - (define-key map "l" 'tpu-undelete-char) ; KP, - (define-key map "n" 'tpu-unselect) ; KP. - (define-key map "M" 'tpu-substitute) ; KPenter - map) - "Maps the function keys on the VT100 keyboard preceded by GOLD-SS3.") - -(defvar GOLD-map +(defvar tpu-gold-map (let ((map (make-keymap))) - (define-key map "\e[" GOLD-CSI-map) ; GOLD-CSI map - (define-key map "\eO" GOLD-SS3-map) ; GOLD-SS3 map + ;; Previously we used escape sequences here. We now instead presume + ;; that term/*.el does its job to map the escape sequence to the right + ;; key-symbol. + + (define-key map [up] 'tpu-move-to-beginning) ; up-arrow + (define-key map [down] 'tpu-move-to-end) ; down-arrow + (define-key map [right] 'end-of-line) ; right-arrow + (define-key map [left] 'beginning-of-line) ; left-arrow + + (define-key map [find] 'nil) ; Find + (define-key map [insert] 'nil) ; Insert Here + (define-key map [delete] 'tpu-store-text) ; Remove + (define-key map [select] 'tpu-unselect) ; Select + (define-key map [prior] 'tpu-previous-window) ; Prev Screen + (define-key map [next] 'tpu-next-window) ; Next Screen + + (define-key map [f1] 'nil) ; F1 + (define-key map [f2] 'nil) ; F2 + (define-key map [f3] 'nil) ; F3 + (define-key map [f4] 'nil) ; F4 + (define-key map [f5] 'nil) ; F5 + (define-key map [f6] 'nil) ; F6 + (define-key map [f7] 'nil) ; F7 + (define-key map [f8] 'nil) ; F8 + (define-key map [f9] 'nil) ; F9 + (define-key map [f10] 'nil) ; F10 + (define-key map [f11] 'nil) ; F11 + (define-key map [f12] 'nil) ; F12 + (define-key map [f13] 'nil) ; F13 + (define-key map [f14] 'nil) ; F14 + (define-key map [help] 'describe-bindings) ; HELP + (define-key map [menu] 'nil) ; DO + (define-key map [f17] 'tpu-drop-breadcrumb) ; F17 + (define-key map [f18] 'nil) ; F18 + (define-key map [f19] 'nil) ; F19 + (define-key map [f20] 'nil) ; F20 + + (define-key map [kp-f1] 'keyboard-quit) ; PF1 + (define-key map [kp-f2] 'help-for-help) ; PF2 + (define-key map [kp-f3] 'tpu-search) ; PF3 + (define-key map [kp-f4] 'tpu-undelete-lines) ; PF4 + (define-key map [kp-0] 'open-line) ; KP0 + (define-key map [kp-1] 'tpu-change-case) ; KP1 + (define-key map [kp-2] 'tpu-delete-to-eol) ; KP2 + (define-key map [kp-3] 'tpu-special-insert) ; KP3 + (define-key map [kp-4] 'tpu-move-to-end) ; KP4 + (define-key map [kp-5] 'tpu-move-to-beginning) ; KP5 + (define-key map [kp-6] 'tpu-paste) ; KP6 + (define-key map [kp-7] 'execute-extended-command) ; KP7 + (define-key map [kp-8] 'tpu-fill) ; KP8 + (define-key map [kp-9] 'tpu-replace) ; KP9 + (define-key map [kp-subtract] 'tpu-undelete-words) ; KP- + (define-key map [kp-separator] 'tpu-undelete-char) ; KP, + (define-key map [kp-decimal] 'tpu-unselect) ; KP. + (define-key map [kp-enter] 'tpu-substitute) ; KPenter + ;; (define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A (define-key map "\C-B" 'nil) ; ^B @@ -553,48 +495,72 @@ CSI is DEC's name for the sequence <ESC>[.") map) "Maps the function keys on the VT100 keyboard preceded by PF1. GOLD is the ASCII 7-bit escape sequence <ESC>OP.") +(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1") -(defvar SS3-map +(defvar tpu-global-map (let ((map (make-sparse-keymap))) - (define-key map "P" GOLD-map) ; GOLD map + + ;; Previously defined in CSI-map. We now presume that term/*.el does + ;; its job to map the escape sequence to the right key-symbol. + (define-key map [find] 'tpu-search) ; Find + (define-key map [insert] 'tpu-paste) ; Insert Here + (define-key map [delete] 'tpu-cut) ; Remove + (define-key map [select] 'tpu-select) ; Select + (define-key map [prior] 'tpu-scroll-window-down) ; Prev Screen + (define-key map [next] 'tpu-scroll-window-up) ; Next Screen + + (define-key map [f1] 'nil) ; F1 + (define-key map [f2] 'nil) ; F2 + (define-key map [f3] 'nil) ; F3 + (define-key map [f4] 'nil) ; F4 + (define-key map [f5] 'nil) ; F5 + (define-key map [f6] 'nil) ; F6 + (define-key map [f7] 'nil) ; F7 + (define-key map [f8] 'nil) ; F8 + (define-key map [f9] 'nil) ; F9 + (define-key map [f10] 'tpu-exit) ; F10 + (define-key map [f11] 'tpu-insert-escape) ; F11 (ESC) + (define-key map [f12] 'tpu-next-beginning-of-line) ; F12 (BS) + (define-key map [f13] 'tpu-delete-previous-word) ; F13 (LF) + (define-key map [f14] 'tpu-toggle-overwrite-mode) ; F14 + (define-key map [help] 'tpu-help) ; HELP + (define-key map [menu] 'execute-extended-command) ; DO + (define-key map [f17] 'tpu-goto-breadcrumb) ; F17 + (define-key map [f18] 'nil) ; F18 + (define-key map [f19] 'nil) ; F19 + (define-key map [f20] 'nil) ; F20 + + + ;; Previously defined in SS3-map. We now presume that term/*.el does + ;; its job to map the escape sequence to the right key-symbol. + (define-key map [kp-f1] tpu-gold-map) ; GOLD map ;; - (define-key map "A" 'tpu-previous-line) ; up - (define-key map "B" 'tpu-next-line) ; down - (define-key map "C" 'tpu-forward-char) ; right - (define-key map "D" 'tpu-backward-char) ; left - - (define-key map "Q" 'tpu-help) ; PF2 - (define-key map "R" 'tpu-search-again) ; PF3 - (define-key map "S" 'tpu-delete-current-line) ; PF4 - (define-key map "p" 'tpu-line) ; KP0 - (define-key map "q" 'tpu-word) ; KP1 - (define-key map "r" 'tpu-end-of-line) ; KP2 - (define-key map "s" 'tpu-char) ; KP3 - (define-key map "t" 'tpu-advance-direction) ; KP4 - (define-key map "u" 'tpu-backup-direction) ; KP5 - (define-key map "v" 'tpu-cut) ; KP6 - (define-key map "w" 'tpu-page) ; KP7 - (define-key map "x" 'tpu-scroll-window) ; KP8 - (define-key map "y" 'tpu-append-region) ; KP9 - (define-key map "m" 'tpu-delete-current-word) ; KP- - (define-key map "l" 'tpu-delete-current-char) ; KP, - (define-key map "n" 'tpu-select) ; KP. - (define-key map "M" 'newline) ; KPenter - map) - "Maps the SS3 function keys on the VT100 keyboard. -SS3 is DEC's name for the sequence <ESC>O.") + (define-key map [up] 'tpu-previous-line) ; up + (define-key map [down] 'tpu-next-line) ; down + (define-key map [right] 'tpu-forward-char) ; right + (define-key map [left] 'tpu-backward-char) ; left + + (define-key map [kp-f2] 'tpu-help) ; PF2 + (define-key map [kp-f3] 'tpu-search-again) ; PF3 + (define-key map [kp-f4] 'tpu-delete-current-line) ; PF4 + (define-key map [kp-0] 'tpu-line) ; KP0 + (define-key map [kp-1] 'tpu-word) ; KP1 + (define-key map [kp-2] 'tpu-end-of-line) ; KP2 + (define-key map [kp-3] 'tpu-char) ; KP3 + (define-key map [kp-4] 'tpu-advance-direction) ; KP4 + (define-key map [kp-5] 'tpu-backup-direction) ; KP5 + (define-key map [kp-6] 'tpu-cut) ; KP6 + (define-key map [kp-7] 'tpu-page) ; KP7 + (define-key map [kp-8] 'tpu-scroll-window) ; KP8 + (define-key map [kp-9] 'tpu-append-region) ; KP9 + (define-key map [kp-subtract] 'tpu-delete-current-word) ; KP- + (define-key map [kp-separator] 'tpu-delete-current-char) ; KP, + (define-key map [kp-decimal] 'tpu-select) ; KP. + (define-key map [kp-enter] 'newline) ; KPenter -(defvar tpu-global-map - (let ((map (make-sparse-keymap))) - (define-key map "\e[" CSI-map) - (define-key map "\eO" SS3-map) map) "TPU-edt global keymap.") -(and (not (boundp 'minibuffer-local-ns-map)) - (defvar minibuffer-local-ns-map (make-sparse-keymap) - "Hack to give Lucid Emacs the same maps as ordinary Emacs.")) - ;;; ;;; Global Variables @@ -697,7 +663,7 @@ SS3 is DEC's name for the sequence <ESC>O.") (setq tpu-mark-flag (if transient-mark-mode "" (if (tpu-mark) " @" " "))) (force-mode-line-update)) -(cond (tpu-lucid-emacs-p +(cond ((featurep 'xemacs) (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line) (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line)) (t @@ -778,7 +744,7 @@ Otherwise sets the tpu-match markers to nil and returns nil." "TPU-edt version of the mark function. Return the appropriate value of the mark for the current version of Emacs." - (cond (tpu-lucid-emacs-p (mark (not zmacs-regions))) + (cond ((featurep 'xemacs) (mark (not zmacs-regions))) (t (and mark-active (mark (not transient-mark-mode)))))) (defun tpu-set-mark (pos) @@ -2366,7 +2332,7 @@ If FILE is nil, try to load a default file. The default file names are (setq file (expand-file-name file))) (tpu-xkeys-file (setq file (expand-file-name tpu-xkeys-file))) - (tpu-lucid-emacs-p + ((featurep 'xemacs) (setq file (convert-standard-filename (expand-file-name "~/.tpu-lucid-keys")))) (t @@ -2382,34 +2348,11 @@ If FILE is nil, try to load a default file. The default file names are (cond ((file-readable-p file) (load-file file)) (t - (switch-to-buffer "*scratch*") - (erase-buffer) - (insert " - - Ack!! You're running TPU-edt under X-windows without loading an - X key definition file. To create a TPU-edt X key definition - file, run the tpu-mapper.el program. It came with TPU-edt. It - even includes directions on how to use it! Perhaps it's lying - around here someplace. ") - (let ((file "tpu-mapper.el") - (found nil) - (path nil) - (search-list (append (list (expand-file-name ".")) load-path))) - (while (and (not found) search-list) - (setq path (concat (car search-list) - (if (string-match "/$" (car search-list)) "" "/") - file)) - (if (and (file-exists-p path) (not (file-directory-p path))) - (setq found t)) - (setq search-list (cdr search-list))) - (cond (found - (insert (format - "Ah yes, there it is, in \n\n %s \n\n" path)) - (if (tpu-y-or-n-p "Do you want to run it now? ") - (load-file path))) - (t - (insert "Nope, I can't seem to find it. :-(\n\n") - (sit-for 120))))))) + ;; FIXME: This used to force the user to build `file'. With the + ;; new code, such a file is not even necessary, but we'll keep + ;; a warning message. + (message "%s not found: use tpu-mapper.el to create it" + (abbreviate-file-name file))))) (defun tpu-copy-keyfile (oldname newname) "Copy the TPU-edt X key definitions file to the new default name." diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el index 975e61c8df3..eeaa5c7c560 100644 --- a/lisp/emulation/tpu-mapper.el +++ b/lisp/emulation/tpu-mapper.el @@ -202,9 +202,9 @@ (setq tpu-key (concat "[" (format "%s" tpu-key-seq) "]")) (cond ((not (equal tpu-key tpu-return)) (set-buffer "Keys") - (insert (format"(global-set-key %s %s)\n" tpu-key func)) + (insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func)) (set-buffer "Gold-Keys") - (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func)) + (insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func)) (set-buffer "Directions")) ;; bogosity to get next prompt to come up, if the user hits <CR>! ;; check periodically to see if this is still needed... @@ -393,5 +393,5 @@ ") (goto-char (point-min)) -;;; arch-tag: bab5872f-cd3a-4c1c-aedb-047b67646f6c +;; arch-tag: bab5872f-cd3a-4c1c-aedb-047b67646f6c ;;; tpu-mapper.el ends here diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 9bd1654020b..f4c0650b1c8 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -106,7 +106,7 @@ ;; define viper-charpair-command-p (viper-test-com-defun viper-charpair-command) -(defconst viper-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l +(defconst viper-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?j ?k ?l ?H ?M ?L ?n ?t ?T ?w ?W ?$ ?% ?^ ?( ?) ?- ?+ ?| ?{ ?} ?[ ?] ?' ?` ?\; ?, ?0 ?? ?/ ?\ ?\C-m @@ -1321,10 +1321,10 @@ as a Meta key and any number of multiple escapes is allowed." (setq last-command-event (viper-copy-event (if viper-xemacs-p (character-to-event char) char))) - (condition-case nil + (condition-case err (funcall cmd-to-exec-at-end cmd-info) (error - (error ""))))) + (error "%s" (error-message-string err)))))) )) (defun viper-describe-arg (arg) @@ -1902,7 +1902,7 @@ With prefix argument, find next destructive command." (setq viper-intermediate-command 'repeating-display-destructive-command) ;; first search through command history--set temp ring - (setq viper-temp-command-ring (copy-list viper-command-ring))) + (setq viper-temp-command-ring (copy-sequence viper-command-ring))) (setq cmd (if next (viper-special-ring-rotate1 viper-temp-command-ring 1) (viper-special-ring-rotate1 viper-temp-command-ring -1))) @@ -1936,7 +1936,7 @@ to in the global map, instead of cycling through the insertion ring." (length viper-last-inserted-string-from-insertion-ring)))) ) ;;first search through insertion history - (setq viper-temp-insertion-ring (copy-list viper-insertion-ring))) + (setq viper-temp-insertion-ring (copy-sequence viper-insertion-ring))) (setq this-command 'viper-insert-from-insertion-ring) ;; so that things will be undone properly (setq buffer-undo-list (cons nil buffer-undo-list)) diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 86e0e044641..4a1bae82711 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -97,6 +97,13 @@ :tag "Is it VMS?" :group 'viper-misc) +(defcustom viper-suppress-input-method-change-message nil + "If t, the message notifying about changes in the input method is not displayed. +Normally, a message is displayed each time on enters the vi, insert or replace +state." + :type 'boolean + :group 'viper-misc) + (defcustom viper-force-faces nil "If t, Viper will think that it is running on a display that supports faces. This is provided as a temporary relief for users of graphics-capable terminals @@ -326,7 +333,8 @@ Use `M-x viper-set-expert-level' to change this.") ;; turn off special input methods in vi-state (if (eq viper-current-state 'vi-state) (viper-set-input-method nil)) - (if (memq viper-current-state '(vi-state insert-state replace-state)) + (if (and (memq viper-current-state '(vi-state insert-state replace-state)) + (not viper-suppress-input-method-change-message)) (message "Viper special input method%s: on" (if (or current-input-method default-input-method) (format " %S" @@ -339,7 +347,8 @@ Use `M-x viper-set-expert-level' to change this.") (if (null viper-mule-hook-flag) () (setq viper-special-input-method nil) - (if (memq viper-current-state '(vi-state insert-state replace-state)) + (if (and (memq viper-current-state '(vi-state insert-state replace-state)) + (not viper-suppress-input-method-change-message)) (message "Viper special input method%s: off" (if (or current-input-method default-input-method) (format " %S" @@ -369,7 +378,7 @@ Use `M-x viper-set-expert-level' to change this.") ;; Set quail-mode to ARG (defun viper-set-input-method (arg) (setq viper-mule-hook-flag t) ; just a precaution - (let (viper-mule-hook-flag) ; temporarily inactivate viper mule hooks + (let (viper-mule-hook-flag) ; temporarily deactivate viper mule hooks (cond ((and arg (> (prefix-numeric-value arg) 0) default-input-method) ;; activate input method (viper-activate-input-method)) diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index 9dd78ce8aa1..1d158274198 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -339,8 +339,8 @@ If running in a terminal, [(escape)] is not understood, so must use \"\\e\"." (define-key viper-vi-basic-map "\C-m" 'viper-next-line-at-bol) (define-key viper-vi-basic-map "\C-u" 'viper-scroll-down) (define-key viper-vi-basic-map "\C-y" 'viper-scroll-down-one) -(define-key viper-vi-basic-map "\C-s" 'viper-isearch-forward) -(define-key viper-vi-basic-map "\C-r" 'viper-isearch-backward) +;;(define-key viper-vi-basic-map "\C-s" 'viper-isearch-forward) +;;(define-key viper-vi-basic-map "\C-r" 'viper-isearch-backward) (define-key viper-vi-basic-map "\C-c/" 'viper-toggle-search-style) (define-key viper-vi-basic-map "\C-c\C-g" 'viper-info-on-file) diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 0419af5fedf..eef92106de2 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -168,7 +168,7 @@ (defun viper-set-cursor-color-according-to-state (&optional frame) (cond ((eq viper-current-state 'replace-state) - (viper-change-cursor-color viper-replace-state-cursor-color frame)) + (viper-change-cursor-color viper-replace-overlay-cursor-color frame)) ((and (eq viper-current-state 'emacs-state) viper-emacs-state-cursor-color) (viper-change-cursor-color viper-emacs-state-cursor-color frame)) @@ -889,9 +889,7 @@ ;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg ;; in sit-for, so this function smoothes out the differences. (defsubst viper-sit-for-short (val &optional nodisp) - (if viper-xemacs-p - (sit-for (/ val 1000.0) nodisp) - (sit-for 0 val nodisp))) + (sit-for (/ val 1000.0) nodisp)) ;; EVENT may be a single event of a sequence of events (defsubst viper-ESC-event-p (event) diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 67ec3660c65..a42e7f1eb91 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -9,7 +9,7 @@ ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Keywords: emulations -(defconst viper-version "3.13.1 of October 23, 2006" +(defconst viper-version "3.14 of June 14, 2007" "The current version of Viper") ;; This file is part of GNU Emacs. @@ -298,7 +298,6 @@ ;;; Code: (require 'advice) -(require 'cl) (require 'ring) ;; compiler pacifier @@ -457,6 +456,7 @@ unless it is coming up in a wrong Viper state." (defcustom viper-insert-state-mode-list '(internal-ange-ftp-mode comint-mode + gud-mode inferior-emacs-lisp-mode erc-mode eshell-mode @@ -481,6 +481,7 @@ unless it is coming up in a wrong Viper state." '((help-mode emacs-state viper-slash-and-colon-map) (comint-mode insert-state viper-comint-mode-modifier-map) (comint-mode vi-state viper-comint-mode-modifier-map) + (gud-mode insert-state viper-comint-mode-modifier-map) (shell-mode insert-state viper-comint-mode-modifier-map) (inferior-emacs-lisp-mode insert-state viper-comint-mode-modifier-map) (shell-mode vi-state viper-comint-mode-modifier-map) @@ -1025,48 +1026,63 @@ It also can't undo some Viper settings." (setq global-mode-string (append '("" viper-mode-string) (cdr global-mode-string)))) - (defadvice describe-key (before viper-describe-key-ad protect activate) - "Force to read key via `viper-read-key-sequence'." - (interactive (let (key) - (setq key (viper-read-key-sequence - "Describe key (or click or menu item): ")) - (list key - (prefix-numeric-value current-prefix-arg) - ;; If KEY is a down-event, read also the - ;; corresponding up-event. - (and (vectorp key) - (let ((last-idx (1- (length key)))) - (and (eventp (aref key last-idx)) - (memq 'down (event-modifiers - (aref key last-idx))))) - (or (and (eventp (aref key 0)) - (memq 'down (event-modifiers - (aref key 0))) - ;; For the C-down-mouse-2 popup - ;; menu, there is no subsequent up-event. - (= (length key) 1)) - (and (> (length key) 1) - (eventp (aref key 1)) - (memq 'down (event-modifiers (aref key 1))))) - (read-event)))))) - - (defadvice describe-key-briefly - (before viper-describe-key-briefly-ad protect activate) - "Force to read key via `viper-read-key-sequence'." - (interactive (let (key) - (setq key (viper-read-key-sequence - "Describe key (or click or menu item): ")) - ;; If KEY is a down-event, read and discard the - ;; corresponding up-event. - (and (vectorp key) - (let ((last-idx (1- (length key)))) - (and (eventp (aref key last-idx)) - (memq 'down (event-modifiers (aref key last-idx))))) - (read-event)) - (list key - (if current-prefix-arg - (prefix-numeric-value current-prefix-arg)) - 1)))) + (viper-cond-compile-for-xemacs-or-emacs + ;; XEmacs + (defadvice describe-key (before viper-describe-key-ad protect activate) + "Force to read key via `viper-read-key-sequence'." + (interactive (list (viper-read-key-sequence "Describe key: ")))) + ;; Emacs + (defadvice describe-key (before viper-describe-key-ad protect activate) + "Force to read key via `viper-read-key-sequence'." + (interactive (let (key) + (setq key (viper-read-key-sequence + "Describe key (or click or menu item): ")) + (list key + (prefix-numeric-value current-prefix-arg) + ;; If KEY is a down-event, read also the + ;; corresponding up-event. + (and (vectorp key) + (let ((last-idx (1- (length key)))) + (and (eventp (aref key last-idx)) + (memq 'down (event-modifiers + (aref key last-idx))))) + (or (and (eventp (aref key 0)) + (memq 'down (event-modifiers + (aref key 0))) + ;; For the C-down-mouse-2 popup menu, + ;; there is no subsequent up-event + (= (length key) 1)) + (and (> (length key) 1) + (eventp (aref key 1)) + (memq 'down (event-modifiers (aref key 1))))) + (read-event)))))) + ) ; viper-cond-compile-for-xemacs-or-emacs + + (viper-cond-compile-for-xemacs-or-emacs + ;; XEmacs + (defadvice describe-key-briefly + (before viper-describe-key-briefly-ad protect activate) + "Force to read key via `viper-read-key-sequence'." + (interactive (list (viper-read-key-sequence "Describe key briefly: ")))) + ;; Emacs + (defadvice describe-key-briefly + (before viper-describe-key-briefly-ad protect activate) + "Force to read key via `viper-read-key-sequence'." + (interactive (let (key) + (setq key (viper-read-key-sequence + "Describe key (or click or menu item): ")) + ;; If KEY is a down-event, read and discard the + ;; corresponding up-event. + (and (vectorp key) + (let ((last-idx (1- (length key)))) + (and (eventp (aref key last-idx)) + (memq 'down (event-modifiers (aref key last-idx))))) + (read-event)) + (list key + (if current-prefix-arg + (prefix-numeric-value current-prefix-arg)) + 1)))) + ) ;; viper-cond-compile-for-xemacs-or-emacs (defadvice find-file (before viper-add-suffix-advice activate) "Use `read-file-name' for reading arguments." diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 9ffbcbd5201..33206ab6cd9 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,7 @@ +2007-06-14 Juanma Barranquero <lekktu@gmail.com> + + * erc-goodies.el (erc-scroll-to-bottom): Remove redundant check. + 2007-06-06 Juanma Barranquero <lekktu@gmail.com> * erc.el (erc-show-channel-key-p, erc-startup-file-list): diff --git a/lisp/erc/erc-goodies.el b/lisp/erc/erc-goodies.el index 933e6b34b52..6820f91628a 100644 --- a/lisp/erc/erc-goodies.el +++ b/lisp/erc/erc-goodies.el @@ -77,7 +77,7 @@ You can control which line is recentered to by customizing the variable `erc-input-line-position'. DISPLAY-START is ignored." - (if (and window (window-live-p window)) + (if (window-live-p window) ;; Temporarily bind resize-mini-windows to nil so that users who have it ;; set to a non-nil value will not suffer from premature minibuffer ;; shrinkage due to the below recenter call. I have no idea why this diff --git a/lisp/filesets.el b/lisp/filesets.el index e13c4a321dd..8b18f910a66 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -354,7 +354,7 @@ See `add-submenu' for documentation." (defcustom filesets-menu-cache-file (if filesets-running-xemacs "~/.xemacs/filesets-cache.el" - "~/.emacs.d/filesets-cache.el") + (concat user-emacs-directory "filesets-cache.el")) "*File to be used for saving the filesets menu between sessions. Set this to \"\", to disable caching of menus. Don't forget to check out `filesets-menu-ensure-use-cached'." diff --git a/lisp/follow.el b/lisp/follow.el index 90555a786cc..048db9bf11a 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -912,7 +912,7 @@ of the way from the true end." "Return all windows displaying the same buffer as the TESTWIN. The list contains only windows displayed in the same frame as TESTWIN. If TESTWIN is nil the selected window is used." - (or (and testwin (window-live-p testwin)) + (or (window-live-p testwin) (setq testwin (selected-window))) (let* ((top (frame-first-window (window-frame testwin))) (win top) @@ -1968,7 +1968,7 @@ report this using the `report-emacs-bug' function." ;; If we're in follow mode, do our stuff. Select a new window and ;; redisplay. (Actually, it is redundant to check `buf', but I ;; feel it's more correct.) - (if (and buf win (window-live-p win)) + (if (and buf (window-live-p win)) (progn (set-buffer buf) (if (and (boundp 'follow-mode) follow-mode) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index dd384e20599..8de4d1370ce 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -698,6 +698,14 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types', ;; contain the new keywords. (font-lock-update-removed-keyword-alist mode keywords how)) (t + (when (and font-lock-mode + (not (or font-lock-keywords font-lock-defaults))) + ;; The major mode has not set any keywords, so when we enabled + ;; font-lock-mode it only enabled the font-core.el part, not the + ;; font-lock-mode-internal. Try again. + (font-lock-mode -1) + (set (make-local-variable 'font-lock-defaults) '(nil t)) + (font-lock-mode 1)) ;; Otherwise set or add the keywords now. ;; This is a no-op if it has been done already in this buffer ;; for the correct major mode. diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 17ef7f996b3..0e9da63da1a 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,14 @@ +2007-06-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-agent.el (gnus-agent-fetch-headers) + (gnus-agent-retrieve-headers): Bind + gnus-decode-encoded-address-function to identity. + + * nntp.el (nntp-send-xover-command): Recognize an xover command is + available also when the server returns simply a dot. + + * gnus-ems.el (gnus-x-splash): Redisplay window before measuring it. + 2007-06-08 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-ems.el (gnus-x-splash): Make it work. diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index 4dac2ac55ea..d4472992aeb 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -6370,8 +6370,7 @@ * message.el (message-required-headers): Add From. -2003-01-02 Katsumi Yamaoka <yamaoka@jpl.org> - Trivial patch from Norbert Koch <nk@viteno.net>. +2003-01-02 Norbert Koch <nk@viteno.net> (tiny change) * gnus-msg.el (gnus-gcc-externalize-attachments): Fix typo. @@ -6984,8 +6983,7 @@ * nnmaildir.el (nnmaildir-request-group): bugfix: don't erase nntp-server-buffer if we aren't going to write to it. -2002-12-04 Katsumi Yamaoka <yamaoka@jpl.org> - Trivial patch from Itai Zukerman <zukerman@math-hat.com>. +2002-12-04 Itai Zukerman <zukerman@math-hat.com> (tiny change) * mm-decode.el (mm-w3m-safe-url-regexp): Fix parenthesis. @@ -7233,8 +7231,7 @@ * nnimap.el (nnimap-request-expire-articles): Compress sequence before storing \Deleted mark on expired articles. -2002-11-17 Shenghuo Zhu <zsh@cs.rochester.edu> - Trivial patch from Markus Rost <rost@math.ohio-state.edu> +2002-11-17 Markus Rost <rost@math.ohio-state.edu> (tiny change) * gnus-sum.el (gnus-summary-goto-unread): Doc fix - escape open parens in column 0. @@ -7906,10 +7903,12 @@ (mml1991-pgg-sign, mml1991-pgg-encrypt): New functions. (mml1991-pgg-encrypt): Fix recipients querying. +2002-09-28 <dme@dme.org> (tiny change) + + * mml2015.el (autoload): Autoload correct files. + 2002-09-28 Simon Josefsson <jas@extundo.com> - * mml2015.el (autoload): Autoload correct files. Trivial patch - from dme@dme.org. (mml2015-pgg-decrypt, mml2015-pgg-verify): Make sure either nil or handle is returned. @@ -8486,12 +8485,10 @@ * imap.el (imap-shell-open): Allow non-list `imap-shell-program'. (imap-shell-open): Skip initial junk before IMAP greeting. -2002-08-11 Simon Josefsson <jas@extundo.com> +2002-08-11 Reiner Steib <Reiner.Steib@gmx.de> - * message-utils.el (message-xpost-default, - message-xpost-fup2-header, message-xpost-fup2): Fixed - Typos. Trivial changes from Reiner Steib - <4uce.02.r.steib@gmx.net>. + * message-utils.el (message-xpost-default) + (message-xpost-fup2-header, message-xpost-fup2): Fixed Typos. 2002-08-09 Simon Josefsson <jas@extundo.com> @@ -9915,10 +9912,9 @@ (mm-inline-wash-with-file): New function. (mm-inline-wash-with-stdin): New function. -2002-02-17 ShengHuo ZHU <zsh@cs.rochester.edu> +2002-02-17 Reiner Steib <Reiner.Steib@gmx.de> * message-utils.el: Fix installation doc. - From: Reiner Steib <4uce.02.r.steib@gmx.net> 2002-02-16 ShengHuo ZHU <zsh@cs.rochester.edu> diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index f54b568a7ef..7a18c42d7cd 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -1768,6 +1768,7 @@ article numbers will be returned." (gnus-uncompress-range (gnus-active group)) (gnus-list-of-unread-articles group))) (gnus-decode-encoded-word-function 'identity) + (gnus-decode-encoded-address-function 'identity) (file (gnus-agent-article-name ".overview" group))) (unless fetch-all @@ -3571,6 +3572,7 @@ has been fetched." (save-excursion (gnus-agent-create-buffer) (let ((gnus-decode-encoded-word-function 'identity) + (gnus-decode-encoded-address-function 'identity) (file (gnus-agent-article-name ".overview" group)) cached-articles uncached-articles) (gnus-make-directory (nnheader-translate-file-chars diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el index 4400b81f041..9b2ddc3ee88 100644 --- a/lisp/gnus/gnus-ems.el +++ b/lisp/gnus/gnus-ems.el @@ -183,6 +183,7 @@ (file (nnheader-find-etc-directory "images/gnus/x-splash" t)) pixmap fcw fch width height fringes sbars left yoffset top ls) (erase-buffer) + (sit-for 0) ;; Necessary for measuring the window size correctly. (when (and file (ignore-errors (let ((coding-system-for-read 'raw-text) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 25b924a93e7..2b62cd7fffa 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -1580,7 +1580,8 @@ password contained in '~/.nntp-authinfo'." ;; article number. How... helpful. (progn (forward-line 1) - (looking-at "[0-9]+\t...")) ; More text after number. + ;; More text after number, or a dot. + (looking-at "[0-9]+\t...\\|\\.\r?\n")) (setq nntp-server-xover (car commands)))) (setq commands (cdr commands))) ;; If none of the commands worked, we disable XOVER. diff --git a/lisp/image-dired.el b/lisp/image-dired.el index 867c50df013..d520d99ea11 100644 --- a/lisp/image-dired.el +++ b/lisp/image-dired.el @@ -166,7 +166,7 @@ :prefix "image-dired-" :group 'multimedia) -(defcustom image-dired-dir "~/.emacs.d/image-dired/" +(defcustom image-dired-dir (concat user-emacs-directory "image-dired/") "Directory where thumbnail images are stored." :type 'string :group 'image-dired) @@ -187,17 +187,20 @@ that allows sharing of thumbnails across different programs." (const :tag "Per-directory" per-directory)) :group 'image-dired) -(defcustom image-dired-db-file "~/.emacs.d/image-dired/.image-dired_db" +(defcustom image-dired-db-file + (concat user-emacs-directory "image-dired/.image-dired_db") "Database file where file names and their associated tags are stored." :type 'string :group 'image-dired) -(defcustom image-dired-temp-image-file "~/.emacs.d/image-dired/.image-dired_temp" +(defcustom image-dired-temp-image-file + (concat user-emacs-directory "image-dired/.image-dired_temp") "Name of temporary image file used by various commands." :type 'string :group 'image-dired) -(defcustom image-dired-gallery-dir "~/.emacs.d/image-dired/.image-dired_gallery" +(defcustom image-dired-gallery-dir + (concat user-emacs-directory "image-dired/.image-dired_gallery") "Directory to store generated gallery html pages. This path needs to be \"shared\" to the public so that it can access the index.html page that image-dired creates." @@ -342,7 +345,7 @@ original image file name and %t which is replaced by :group 'image-dired) (defcustom image-dired-temp-rotate-image-file - "~/.emacs.d/image-dired/.image-dired_rotate_temp" + (concat user-emacs-directory "image-dired/.image-dired_rotate_temp") "Temporary file for rotate operations." :type 'string :group 'image-dired) diff --git a/lisp/indent.el b/lisp/indent.el index 0b0588ab515..7a94963ff4d 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -50,8 +50,8 @@ Don't rebind TAB unless you really need to.") "*Controls the operation of the TAB key. If t, hitting TAB always just indents the current line. If nil, hitting TAB indents the current line if point is at the left margin -or in the line's indentation, otherwise it insert a \"real\" TAB character. -Most programming language modes have their own variable to control this, +or in the line's indentation, otherwise it inserts a \"real\" TAB character. +Some programming language modes have their own variable to control this, e.g., `c-tab-always-indent', and do not respect this variable." :group 'indent :type '(choice (const nil) (const t) (const always))) diff --git a/lisp/log-view.el b/lisp/log-view.el index e4f50c15351..bf029045a8c 100644 --- a/lisp/log-view.el +++ b/lisp/log-view.el @@ -129,14 +129,15 @@ (defvar log-view-message-face 'log-view-message) (defconst log-view-file-re - (concat "^\\(?:Working file: \\(.+\\)" ;RCS and CVS. - "\\|\\(?:SCCS/s\\.\\|Changes to \\)\\(.+\\):" ;SCCS and Darcs. + (concat "^\\(?:Working file: \\(?1:.+\\)" ;RCS and CVS. + ;; Subversion has no such thing?? + "\\|\\(?:SCCS/s\\.\\|Changes to \\)\\(?1:.+\\):" ;SCCS and Darcs. "\\)\n")) ;Include the \n for font-lock reasons. (defconst log-view-message-re - (concat "^\\(?:revision \\([.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS. - "\\|r\\([0-9]+\\) | .* | .*" ; Subversion. - "\\|D \\([.0-9]+\\) .*" ; SCCS. + (concat "^\\(?:revision \\(?1:[.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS. + "\\|r\\(?1:[0-9]+\\) | .* | .*" ; Subversion. + "\\|D \\(?1:[.0-9]+\\) .*" ; SCCS. ;; Darcs doesn't have revision names. VC-darcs uses patch names ;; instead. Darcs patch names are hashcodes, which do not appear ;; in the log output :-(, but darcs accepts any prefix of the log @@ -145,13 +146,12 @@ ;; First loosely match the date format. (concat "\\|[^ \n].*[^0-9\n][0-9][0-9]:[0-9][0-9][^0-9\n].*[^ \n]" ;;Email of user and finally Msg, used as revision name. - " .*@.*\n\\(?: \\* \\(.*\\)\\)?") + " .*@.*\n\\(?: \\* \\(?1:.*\\)\\)?") "\\)$")) (defconst log-view-font-lock-keywords `((,log-view-file-re - (1 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t) - (2 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t) + (1 (if (boundp 'cvs-filename-face) cvs-filename-face)) (0 log-view-file-face append)) (,log-view-message-re . log-view-message-face))) (defconst log-view-font-lock-defaults @@ -194,7 +194,7 @@ (forward-line 1) (or (re-search-backward log-view-file-re nil t) (re-search-forward log-view-file-re)) - (let* ((file (or (match-string 1) (match-string 2))) + (let* ((file (match-string 1)) (cvsdir (and (re-search-backward log-view-dir-re nil t) (match-string 1))) (pcldir (and (boundp 'cvs-pcl-cvs-dirchange-re) @@ -212,10 +212,7 @@ (forward-line 1) (let ((pt (point))) (when (re-search-backward log-view-message-re nil t) - (let (rev) - ;; Find the subgroup that matched. - (dotimes (i (/ (length (match-data 'integers)) 2)) - (setq rev (or rev (match-string (1+ i))))) + (let ((rev (match-string 1))) (unless (re-search-forward log-view-file-re pt t) rev)))))) diff --git a/lisp/mb-depth.el b/lisp/mb-depth.el new file mode 100644 index 00000000000..256c7ee6a99 --- /dev/null +++ b/lisp/mb-depth.el @@ -0,0 +1,72 @@ +;;; mb-depth.el --- Indicate minibuffer-depth in prompt +;; +;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. +;; +;; Author: Miles Bader <miles@gnu.org> +;; Keywords: convenience + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; Defines the minor mode `minibuffer-indicate-depth-mode'. +;; +;; When active, any recursive use of the minibuffer will show +;; the recursion depth in the minibuffer prompt. This is only +;; useful if `enable-recursive-minibuffers' is non-nil. + +;;; Code: + +;; An overlay covering the prompt. This is a buffer-local variable in +;; each affected minibuffer. +;; +(defvar minibuf-depth-overlay) +(make-variable-buffer-local 'minibuf-depth-overlay) + +;; This function goes on minibuffer-setup-hook +(defun minibuf-depth-setup-minibuffer () + "Set up a minibuffer for `minibuffer-indicate-depth-mode'. +The prompt should already have been inserted." + (when (> (minibuffer-depth) 1) + (setq minibuf-depth-overlay (make-overlay (point-min) (1+ (point-min)))) + (overlay-put minibuf-depth-overlay 'before-string + (propertize (format "[%d]" (minibuffer-depth)) + 'face 'highlight)) + (overlay-put minibuf-depth-overlay 'evaporate t))) + +;;;###autoload +(define-minor-mode minibuffer-indicate-depth-mode + "Toggle Minibuffer Indicate Depth mode. +When active, any recursive use of the minibuffer will show +the recursion depth in the minibuffer prompt. This is only +useful if `enable-recursive-minibuffers' is non-nil. + +With prefix argument ARG, turn on if positive, otherwise off. +Returns non-nil if the new state is enabled." + :global t + :group 'minibuffer + (if minibuffer-indicate-depth-mode + ;; Enable the mode + (add-hook 'minibuffer-setup-hook 'minibuf-depth-setup-minibuffer) + ;; Disable the mode + (remove-hook 'minibuffer-setup-hook 'minibuf-depth-setup-minibuffer))) + +(provide 'mb-depth) + +;; arch-tag: 50224089-5bf5-46f8-803d-18f018c5eacf +;;; mb-depth.el ends here diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 60d81aedb7a..04f3fa45ceb 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -55,9 +55,24 @@ :link '(custom-manual "(rcirc)") :group 'applications) -(defcustom rcirc-default-server "irc.freenode.net" - "The default server to connect to." - :type 'string +(defcustom rcirc-connections + '(("irc.freenode.net" :channels ("#rcirc"))) + "An alist of IRC connections to establish when running `rcirc'. +Each element looks like (SERVER-NAME PARAMETERS). + +SERVER-NAME is a string describing the server to connect +to. + +PARAMETERS is a plist of optional connection parameters. Valid +properties are: nick (a string), port (number or string), +user-name (string), full-name (string), and channels (list of +strings)." + :type '(alist :key-type string + :value-type (plist :options ((nick string) + (port integer) + (user-name string) + (full-name string) + (channels (repeat string))))) :group 'rcirc) (defcustom rcirc-default-port 6667 @@ -82,12 +97,6 @@ :type 'string :group 'rcirc) -(defcustom rcirc-startup-channels-alist '(("^irc.freenode.net$" "#rcirc")) - "Alist of channels to join at startup. -Each element looks like (SERVER-REGEXP . CHANNEL-LIST)." - :type '(alist :key-type string :value-type (repeat string)) - :group 'rcirc) - (defcustom rcirc-fill-flag t "*Non-nil means line-wrap messages printed in channel buffers." :type 'boolean @@ -95,11 +104,9 @@ Each element looks like (SERVER-REGEXP . CHANNEL-LIST)." (defcustom rcirc-fill-column nil "*Column beyond which automatic line-wrapping should happen. -If nil, use value of `fill-column'. -If `window-width', use the window's width as maximum. -If `frame-width', use the frame's width as maximum." +If nil, use value of `fill-column'. If 'frame-width, use the +maximum frame width." :type '(choice (const :tag "Value of `fill-column'") - (const :tag "Full window width" window-width) (const :tag "Full frame width" frame-width) (integer :tag "Number of columns")) :group 'rcirc) @@ -120,6 +127,11 @@ underneath each nick." "If non-nil, activity in this buffer is considered low priority.") (make-variable-buffer-local 'rcirc-low-priority-flag) +(defvar rcirc-omit-mode nil + "Non-nil if Rcirc-Omit mode is enabled. +Use the command `rcirc-omit-mode' to change this variable.") +(make-variable-buffer-local 'rcirc-omit-mode) + (defcustom rcirc-time-format "%H:%M " "*Describes how timestamps are printed. Used as the first arg to `format-time-string'." @@ -145,7 +157,8 @@ number. If zero or nil, no truncating is done." :group 'rcirc) (defcustom rcirc-scroll-show-maximum-output t - "*If non-nil, scroll buffer to keep the point at the bottom of the window." + "*If non-nil, scroll buffer to keep the point at the bottom of +the window." :type 'boolean :group 'rcirc) @@ -319,36 +332,69 @@ and the cdr part is used for encoding." (defconst rcirc-id-string (concat "rcirc on GNU Emacs " emacs-version)) (defvar rcirc-startup-channels nil) + ;;;###autoload (defun rcirc (arg) - "Connect to IRC. -If ARG is non-nil, prompt for a server to connect to." + "Connect to all servers in `rcirc-connections'. + +Do not connect to a server if it is already connected. + +If ARG is non-nil, instead prompt for connection parameters." (interactive "P") (if arg - (let* ((server (read-string "IRC Server: " rcirc-default-server)) - (port (read-string "IRC Port: " (number-to-string rcirc-default-port))) - (nick (read-string "IRC Nick: " rcirc-default-nick)) + (let* ((server (completing-read "IRC Server: " + rcirc-connections + nil nil + (caar rcirc-connections))) + (server-plist (cdr (assoc-string server rcirc-connections))) + (port (read-string "IRC Port: " + (number-to-string + (or (plist-get server-plist 'port) + rcirc-default-port)))) + (nick (read-string "IRC Nick: " + (or (plist-get server-plist 'nick) + rcirc-default-nick))) (channels (split-string (read-string "IRC Channels: " - (mapconcat 'identity (rcirc-startup-channels server) " ")) + (mapconcat 'identity + (plist-get server-plist + 'channels) + " ")) "[, ]+" t))) - (rcirc-connect server port nick rcirc-default-user-name rcirc-default-user-full-name + (rcirc-connect server port nick rcirc-default-user-name + rcirc-default-user-full-name channels)) - ;; make new connection using defaults unless already connected to - ;; the default rcirc-server - (let (connected) - (dolist (p (rcirc-process-list)) - (when (string= rcirc-default-server (process-name p)) - (setq connected p))) - (if (not connected) - (rcirc-connect rcirc-default-server rcirc-default-port - rcirc-default-nick rcirc-default-user-name - rcirc-default-user-full-name - (rcirc-startup-channels rcirc-default-server)) - (switch-to-buffer (process-buffer connected)) - (message "Connected to %s" - (process-contact (get-buffer-process (current-buffer)) - :host)))))) + ;; connect to servers in `rcirc-connections' + (let (connected-servers) + (dolist (c rcirc-connections) + (let ((server (car c)) + (port (or (plist-get (cdr c) 'port) rcirc-default-port)) + (nick (or (plist-get (cdr c) 'nick) rcirc-default-nick)) + (user-name (or (plist-get (cdr c) 'user-name) + rcirc-default-user-name)) + (full-name (or (plist-get (cdr c) 'full-name) + rcirc-default-user-full-name)) + (channels (plist-get (cdr c) 'channels))) + (when server + (let (connected) + (dolist (p (rcirc-process-list)) + (when (string= server (process-name p)) + (setq connected p))) + (if (not connected) + (condition-case e + (rcirc-connect server port nick user-name + full-name channels) + (quit (message "Quit connecting to %s" server))) + (with-current-buffer (process-buffer connected) + (setq connected-servers + (cons (process-contact (get-buffer-process + (current-buffer)) :host) + connected-servers)))))))) + (when connected-servers + (message "Already connected to %s" + (concat (mapconcat 'identity (butlast connected-servers) ", ") + ", and " (car (last connected-servers)))))))) + ;;;###autoload (defalias 'irc 'rcirc) @@ -365,7 +411,8 @@ If ARG is non-nil, prompt for a server to connect to." (defvar rcirc-process nil) ;;;###autoload -(defun rcirc-connect (&optional server port nick user-name full-name startup-channels) +(defun rcirc-connect (server &optional port nick user-name full-name + startup-channels) (save-excursion (message "Connecting to %s..." server) (let* ((inhibit-eol-conversion) @@ -374,7 +421,6 @@ If ARG is non-nil, prompt for a server to connect to." (string-to-number port) port) rcirc-default-port)) - (server (or server rcirc-default-server)) (nick (or nick rcirc-default-nick)) (user-name (or user-name rcirc-default-user-name)) (full-name (or full-name rcirc-default-user-full-name)) @@ -412,6 +458,8 @@ If ARG is non-nil, prompt for a server to connect to." (make-local-variable 'rcirc-connecting) (setq rcirc-connecting t) + (add-hook 'auto-save-hook 'rcirc-log-write) + ;; identify (rcirc-send-string process (concat "NICK " nick)) (rcirc-send-string process (concat "USER " user-name @@ -446,12 +494,21 @@ last ping." (mapc (lambda (process) (with-rcirc-process-buffer process (when (not rcirc-connecting) - (rcirc-send-string process (concat "PING " (rcirc-server-name process)))))) + (rcirc-send-string process + (format "PRIVMSG %s :\C-aKEEPALIVE %f\C-a" + rcirc-nick + (time-to-seconds + (current-time))))))) (rcirc-process-list)) ;; no processes, clean up timer (cancel-timer rcirc-keepalive-timer) (setq rcirc-keepalive-timer nil))) +(defun rcirc-handler-ctcp-KEEPALIVE (process target sender message) + (with-rcirc-process-buffer process + (setq header-line-format (format "%f" (- (time-to-seconds (current-time)) + (string-to-number message)))))) + (defvar rcirc-debug-buffer " *rcirc debug*") (defvar rcirc-debug-flag nil "If non-nil, write information to `rcirc-debug-buffer'.") @@ -461,14 +518,13 @@ Debug text is written to `rcirc-debug-buffer' if `rcirc-debug-flag' is non-nil." (when rcirc-debug-flag (save-excursion - (save-window-excursion - (set-buffer (get-buffer-create rcirc-debug-buffer)) - (goto-char (point-max)) - (insert (concat - "[" - (format-time-string "%Y-%m-%dT%T ") (process-name process) - "] " - text)))))) + (set-buffer (get-buffer-create rcirc-debug-buffer)) + (goto-char (point-max)) + (insert (concat + "[" + (format-time-string "%Y-%m-%dT%T ") (process-name process) + "] " + text))))) (defvar rcirc-sentinel-hooks nil "Hook functions called when the process sentinel is called. @@ -486,12 +542,16 @@ Functions are called with PROCESS and SENTINEL arguments.") (process-name process) sentinel (process-status process)) (not rcirc-target)) - ;; remove the prompt from buffers - (let ((inhibit-read-only t)) - (delete-region rcirc-prompt-start-marker - rcirc-prompt-end-marker)))) + (rcirc-disconnect-buffer))) (run-hook-with-args 'rcirc-sentinel-hooks process sentinel)))) +(defun rcirc-disconnect-buffer (&optional buffer) + (with-current-buffer (or buffer (current-buffer)) + ;; set rcirc-target to nil for each channel so cleanup + ;; doesnt happen when we reconnect + (setq rcirc-target nil) + (setq mode-line-process ":disconnected"))) + (defun rcirc-process-list () "Return a list of rcirc processes." (let (ps) @@ -593,7 +653,8 @@ With no argument or nil as argument, use the current buffer." (defun rcirc-server-name (process) "Return PROCESS server name, given by the 001 response." (with-rcirc-process-buffer process - (or rcirc-server-name rcirc-default-server))) + (or rcirc-server-name + (warn "server name for process %S unknown" process)))) (defun rcirc-nick (process) "Return PROCESS nick." @@ -610,9 +671,10 @@ With no argument or nil as argument, use the current buffer." (defvar rcirc-max-message-length 420 "Messages longer than this value will be split.") -(defun rcirc-send-message (process target message &optional noticep) +(defun rcirc-send-message (process target message &optional noticep silent) "Send TARGET associated with PROCESS a privmsg with text MESSAGE. -If NOTICEP is non-nil, send a notice instead of privmsg." +If NOTICEP is non-nil, send a notice instead of privmsg. +If SILENT is non-nil, do not print the message in any irc buffer." ;; max message length is 512 including CRLF (let* ((response (if noticep "NOTICE" "PRIVMSG")) (oversize (> (length message) rcirc-max-message-length)) @@ -625,8 +687,9 @@ If NOTICEP is non-nil, send a notice instead of privmsg." (more (if oversize (substring message rcirc-max-message-length)))) (rcirc-get-buffer-create process target) - (rcirc-print process (rcirc-nick process) response target text) (rcirc-send-string process (concat response " " target " :" text)) + (unless silent + (rcirc-print process (rcirc-nick process) response target text)) (when more (rcirc-send-message process target more noticep)))) (defvar rcirc-input-ring nil) @@ -711,7 +774,7 @@ If NOTICEP is non-nil, send a notice instead of privmsg." (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-cmd-oper) +(define-key rcirc-mode-map (kbd "C-c C-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) @@ -737,6 +800,10 @@ If NOTICEP is non-nil, send a notice instead of privmsg." (defvar rcirc-last-post-time nil) +(defvar rcirc-log-alist nil + "Alist of lines to log to disk when `rcirc-log-flag' is non-nil. +Each element looks like (FILENAME . TEXT).") + (defun rcirc-mode (process target) "Major mode for IRC channel buffers. @@ -745,6 +812,7 @@ If NOTICEP is non-nil, send a notice instead of privmsg." (use-local-map rcirc-mode-map) (setq mode-name "rcirc") (setq major-mode 'rcirc-mode) + (setq mode-line-process nil) (make-local-variable 'rcirc-input-ring) (setq rcirc-input-ring (make-ring rcirc-input-ring-size)) @@ -756,6 +824,8 @@ If NOTICEP is non-nil, send a notice instead of privmsg." (setq rcirc-topic nil) (make-local-variable 'rcirc-last-post-time) (setq rcirc-last-post-time (current-time)) + (make-local-variable 'fill-paragraph-function) + (setq fill-paragraph-function 'rcirc-fill-paragraph) (make-local-variable 'rcirc-short-buffer-name) (setq rcirc-short-buffer-name nil) @@ -785,6 +855,8 @@ If NOTICEP is non-nil, send a notice instead of privmsg." (setq overlay-arrow-position (make-marker)) (set-marker overlay-arrow-position nil) + (setq buffer-invisibility-spec '(rcirc-ignored-user)) + ;; if the user changes the major mode or kills the buffer, there is ;; cleanup work to do (add-hook 'change-major-mode-hook 'rcirc-change-major-mode-hook nil t) @@ -873,14 +945,16 @@ If ALL is non-nil, update prompts in all IRC buffers." (when rcirc-target (rcirc-remove-nick-channel (rcirc-buffer-process) (rcirc-buffer-nick) - rcirc-target)))))) + rcirc-target)))) + (setq rcirc-target nil))) (defun rcirc-generate-new-buffer-name (process target) "Return a buffer name based on PROCESS and TARGET. This is used for the initial name given to IRC buffers." - (if target - (concat target "@" (process-name process)) - (concat "*" (process-name process) "*"))) + (substring-no-properties + (if target + (concat target "@" (process-name process)) + (concat "*" (process-name process) "*")))) (defun rcirc-get-buffer (process target &optional server) "Return the buffer associated with the PROCESS and TARGET. @@ -902,14 +976,14 @@ Create the buffer if it doesn't exist." (when (not rcirc-target) (setq rcirc-target target)) buffer) - ;; create the buffer - (with-rcirc-process-buffer process - (let ((new-buffer (get-buffer-create - (rcirc-generate-new-buffer-name process target)))) - (with-current-buffer new-buffer - (rcirc-mode process target)) - (rcirc-put-nick-channel process (rcirc-nick process) target) - new-buffer))))) + ;; create the buffer + (with-rcirc-process-buffer process + (let ((new-buffer (get-buffer-create + (rcirc-generate-new-buffer-name process target)))) + (with-current-buffer new-buffer + (rcirc-mode process target)) + (rcirc-put-nick-channel process (rcirc-nick process) target) + new-buffer))))) (defun rcirc-send-input () "Send input to target associated with the current buffer." @@ -943,6 +1017,14 @@ Create the buffer if it doesn't exist." (ring-insert rcirc-input-ring input) (setq rcirc-input-ring-index 0)))))) +(defun rcirc-fill-paragraph (&optional arg) + (interactive "p") + (when (> (point) rcirc-prompt-end-marker) + (save-restriction + (narrow-to-region rcirc-prompt-end-marker (point-max)) + (let ((fill-column rcirc-max-message-length)) + (fill-region (point-min) (point-max)))))) + (defun rcirc-process-input-line (line) (if (string-match "^/\\([^ ]+\\) ?\\(.*\\)$" line) (rcirc-process-command (match-string 1 line) @@ -1021,7 +1103,6 @@ Create the buffer if it doesn't exist." (defun rcirc-multiline-minor-submit () "Send the text in buffer back to parent buffer." (interactive) - (assert rcirc-parent-buffer) (untabify (point-min) (point-max)) (let ((text (buffer-substring (point-min) (point-max))) (buffer (current-buffer)) @@ -1052,12 +1133,12 @@ Create the buffer if it doesn't exist." (process-buffer process))))) (defcustom rcirc-response-formats - '(("PRIVMSG" . "%T<%N> %m") - ("NOTICE" . "%T-%N- %m") - ("ACTION" . "%T[%N %m]") - ("COMMAND" . "%T%m") - ("ERROR" . "%T%fw!!! %m") - (t . "%T%fp*** %fs%n %r %m")) + '(("PRIVMSG" . "<%N> %m") + ("NOTICE" . "-%N- %m") + ("ACTION" . "[%N %m]") + ("COMMAND" . "%m") + ("ERROR" . "%fw!!! %m") + (t . "%fp*** %fs%n %r %m")) "An alist of formats used for printing responses. The format is looked up using the response-type as a key; if no match is found, the default entry (with a key of `t') is used. @@ -1069,7 +1150,6 @@ the of the following escape sequences replaced by the described values: %n The sender's nick %N The sender's nick (with face `rcirc-my-nick' or `rcirc-other-nick') %r The response-type - %T The timestamp (with face `rcirc-timestamp') %t The target %fw Following text uses the face `font-lock-warning-face' %fp Following text uses the face `rcirc-server-prefix' @@ -1082,92 +1162,67 @@ the of the following escape sequences replaced by the described values: :value-type string) :group 'rcirc) +(defcustom rcirc-omit-responses + '("JOIN" "PART" "QUIT") + "Responses which will be hidden when `rcirc-omit-mode' is enabled." + :type '(repeat string) + :group 'rcirc) + (defun rcirc-format-response-string (process sender response target text) "Return a nicely-formatted response string, incorporating TEXT \(and perhaps other arguments). The specific formatting used is found by looking up RESPONSE in `rcirc-response-formats'." - (let ((chunks - (split-string (or (cdr (assoc response rcirc-response-formats)) - (cdr (assq t rcirc-response-formats))) - "%")) - (sender (or sender "")) - (result "") - (face nil) - key face-key repl) - (when (equal (car chunks) "") - (pop chunks)) - (dolist (chunk chunks) - (if (equal chunk "") - (setq key ?%) - (setq key (aref chunk 0)) - (setq chunk (substring chunk 1))) - (setq repl - (cond ((eq key ?%) - ;; %% -- literal % character - "%") - ((or (eq key ?n) (eq key ?N)) - ;; %n/%N -- nick - (let ((nick (concat (if (string= (rcirc-server-name process) - sender) - "" - sender) - (and target (concat "," target))))) - (rcirc-facify nick - (if (eq key ?n) - face - (cond ((string= sender (rcirc-nick process)) - 'rcirc-my-nick) - ((and rcirc-bright-nicks - (string-match - (regexp-opt rcirc-bright-nicks) - sender)) - 'rcirc-bright-nick) - ((and rcirc-dim-nicks - (string-match - (regexp-opt rcirc-dim-nicks) - sender)) - 'rcirc-dim-nick) - (t - 'rcirc-other-nick)))))) - ((eq key ?T) - ;; %T -- timestamp - (rcirc-facify - (format-time-string rcirc-time-format (current-time)) - 'rcirc-timestamp)) - ((eq key ?m) - ;; %m -- message text - (rcirc-markup-text process sender response (rcirc-facify text face))) - ((eq key ?t) - ;; %t -- target - (rcirc-facify (or rcirc-target "") face)) - ((eq key ?r) - ;; %r -- response - (rcirc-facify response face)) - ((eq key ?f) - ;; %f -- change face - (setq face-key (aref chunk 0)) - (setq chunk (substring chunk 1)) - (cond ((eq face-key ?w) - ;; %fw -- warning face - (setq face 'font-lock-warning-face)) - ((eq face-key ?p) - ;; %fp -- server-prefix face - (setq face 'rcirc-server-prefix)) - ((eq face-key ?s) - ;; %fs -- warning face - (setq face 'rcirc-server)) - ((eq face-key ?-) - ;; %fs -- warning face - (setq face nil)) - ((and (eq face-key ?\[) - (string-match "^\\([^]]*\\)[]]" chunk) - (facep (match-string 1 chunk))) - ;; %f[...] -- named face - (setq face (intern (match-string 1 chunk))) - (setq chunk (substring chunk (match-end 0))))) - ""))) - (setq result (concat result repl (rcirc-facify chunk face)))) - result)) + (with-temp-buffer + (insert (or (cdr (assoc response rcirc-response-formats)) + (cdr (assq t rcirc-response-formats)))) + (goto-char (point-min)) + (let ((start (point-min)) + (sender (if (or (not sender) + (string= (rcirc-server-name process) sender)) + "" + sender)) + face) + (while (re-search-forward "%\\(\\(f\\(.\\)\\)\\|\\(.\\)\\)" nil t) + (rcirc-add-face start (match-beginning 0) face) + (setq start (match-beginning 0)) + (replace-match + (case (aref (match-string 1) 0) + (?f (setq face + (case (string-to-char (match-string 3)) + (?w 'font-lock-warning-face) + (?p 'rcirc-server-prefix) + (?s 'rcirc-server) + (t nil))) + "") + (?n sender) + (?N (let ((my-nick (rcirc-nick process))) + (save-match-data + (with-syntax-table rcirc-nick-syntax-table + (rcirc-facify sender + (cond ((string= sender my-nick) + 'rcirc-my-nick) + ((and rcirc-bright-nicks + (string-match + (regexp-opt rcirc-bright-nicks + 'words) + sender)) + 'rcirc-bright-nick) + ((and rcirc-dim-nicks + (string-match + (regexp-opt rcirc-dim-nicks + 'words) + sender)) + 'rcirc-dim-nick) + (t + 'rcirc-other-nick))))))) + (?m (propertize text 'rcirc-text text)) + (?r response) + (?t (or target "")) + (t (concat "UNKNOWN CODE:" (match-string 0)))) + t t nil 0) + (rcirc-add-face (match-beginning 0) (match-end 0) face)) + (rcirc-add-face start (match-beginning 0) face)) + (buffer-substring (point-min) (point-max)))) (defun rcirc-target-buffer (process sender response target text) "Return a buffer to print the server response." @@ -1177,7 +1232,8 @@ is found by looking up RESPONSE in `rcirc-response-formats'." (rcirc-any-buffer process)) ((not (rcirc-channel-p target)) ;; message from another user - (if (string= response "PRIVMSG") + (if (or (string= response "PRIVMSG") + (string= response "ACTION")) (rcirc-get-buffer-create process (if (string= sender rcirc-nick) target sender)) @@ -1190,6 +1246,17 @@ 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) + (defun rcirc-print (process sender response target text &optional activity) "Print TEXT in the buffer associated with TARGET. Format based on SENDER and RESPONSE. If ACTIVITY is non-nil, @@ -1212,7 +1279,8 @@ record activity." (setq text (decode-coding-string text rcirc-decode-coding-system)) ;; mark the line with overlay arrow (unless (or (marker-position overlay-arrow-position) - (get-buffer-window (current-buffer))) + (get-buffer-window (current-buffer)) + (member response rcirc-omit-responses)) (set-marker overlay-arrow-position (marker-position rcirc-prompt-start-marker)))) @@ -1222,44 +1290,40 @@ record activity." (set-marker-insertion-type rcirc-prompt-start-marker t) (set-marker-insertion-type rcirc-prompt-end-marker t) - (let ((fmted-text - (rcirc-format-response-string process sender response nil - text))) - - (insert fmted-text (propertize "\n" 'hard t)) - (set-marker-insertion-type rcirc-prompt-start-marker nil) - (set-marker-insertion-type rcirc-prompt-end-marker nil) - - (let ((text-start (make-marker))) - (set-marker text-start - (or (next-single-property-change fill-start - 'rcirc-text) - rcirc-prompt-end-marker)) - ;; squeeze spaces out of text before rcirc-text - (fill-region fill-start (1- text-start)) - - ;; fill the text we just inserted, maybe - (when (and rcirc-fill-flag - (not (string= response "372"))) ;/motd - (let ((fill-prefix - (or rcirc-fill-prefix - (make-string (- text-start fill-start) ?\s))) - (fill-column (cond ((eq rcirc-fill-column 'frame-width) - (1- (frame-width))) - ((eq rcirc-fill-column 'window-width) - (1- (window-width))) - (rcirc-fill-column - rcirc-fill-column) - (t fill-column)))) - (fill-region fill-start rcirc-prompt-start-marker 'left t))))) - - ;; set inserted text to be read-only - (when rcirc-read-only-flag - (put-text-property rcirc-prompt-start-marker fill-start 'read-only t) - (let ((inhibit-read-only t)) - (put-text-property rcirc-prompt-start-marker fill-start - 'front-sticky t) - (put-text-property (1- (point)) (point) 'rear-nonsticky t))) + (let ((start (point))) + (insert (rcirc-format-response-string process sender response nil + text) + (propertize "\n" 'hard t)) + + ;; squeeze spaces out of text before rcirc-text + (fill-region fill-start + (1- (or (next-single-property-change fill-start + 'rcirc-text) + rcirc-prompt-end-marker))) + + ;; run markup functions + (save-excursion + (save-restriction + (narrow-to-region start rcirc-prompt-start-marker) + (goto-char (or (next-single-property-change start 'rcirc-text) + (point))) + (when (rcirc-buffer-process) + (save-excursion (rcirc-markup-timestamp sender response)) + (dolist (fn rcirc-markup-text-functions) + (save-excursion (funcall fn sender response))) + (save-excursion (rcirc-markup-fill sender response))) + + (when rcirc-read-only-flag + (add-text-properties (point-min) (point-max) + '(read-only t front-sticky t)))) + ;; make text omittable + (when (and (member response rcirc-omit-responses) + (> start (point-min))) + (put-text-property (1- start) (1- rcirc-prompt-start-marker) + 'invisible 'rcirc-omit)))) + + (set-marker-insertion-type rcirc-prompt-start-marker nil) + (set-marker-insertion-type rcirc-prompt-end-marker nil) ;; truncate buffer if it is very long (save-excursion @@ -1275,27 +1339,26 @@ record activity." (window-buffer w)) (>= (window-point w) rcirc-prompt-end-marker)) - (set-window-point w (point-max)))) + (set-window-point w (point-max)))) nil t) ;; restore the point (goto-char (if moving rcirc-prompt-end-marker old-point)) - ;; keep window on bottom line if it was already there + ;; keep window on bottom line if it was already there (when rcirc-scroll-show-maximum-output (walk-windows (lambda (w) (when (eq (window-buffer w) (current-buffer)) (with-current-buffer (window-buffer w) (when (eq major-mode 'rcirc-mode) (with-selected-window w - (when (<= (- (window-height) - (count-screen-lines - (window-point) - (window-start)) + (when (<= (- (window-height) + (count-screen-lines (window-point) + (window-start)) 1) 0) (recenter -1))))))) - nil t)) + nil t)) ;; flush undo (can we do something smarter here?) (buffer-disable-undo) @@ -1305,22 +1368,45 @@ record activity." (when (and activity (not rcirc-ignore-buffer-activity-flag) (not (and rcirc-dim-nicks sender - (string-match (regexp-opt rcirc-dim-nicks) sender)))) + (string-match (regexp-opt rcirc-dim-nicks) sender) + (rcirc-channel-p target)))) (rcirc-record-activity (current-buffer) (when (not (rcirc-channel-p rcirc-target)) 'nick))) + (when rcirc-log-flag + (rcirc-log process sender response target text)) + (sit-for 0) ; displayed text before hook (run-hook-with-args 'rcirc-print-hooks process sender response target text))))) -(defun rcirc-startup-channels (server) - "Return the list of startup channels for SERVER." - (let (channels) - (dolist (i rcirc-startup-channels-alist) - (if (string-match (car i) server) - (setq channels (append channels (cdr i))))) - channels)) +(defun rcirc-log (process sender response target text) + "Record line in `rcirc-log', to be later written to disk." + (let* ((filename (rcirc-generate-new-buffer-name process target)) + (cell (assoc-string filename rcirc-log-alist)) + (line (concat (format-time-string rcirc-time-format) + (substring-no-properties + (rcirc-format-response-string process sender + response target text)) + "\n"))) + (if cell + (setcdr cell (concat (cdr cell) line)) + (setq rcirc-log-alist + (cons (cons filename line) rcirc-log-alist))))) + +(defun rcirc-log-write () + "Flush `rcirc-log-alist' data to disk. + +Log data is written to `rcirc-log-directory'." + (make-directory rcirc-log-directory t) + (dolist (cell rcirc-log-alist) + (with-temp-buffer + (insert (cdr cell)) + (write-region (point-min) (point-max) + (concat rcirc-log-directory "/" (car cell)) + t 'quiet))) + (setq rcirc-log-alist nil)) (defun rcirc-join-channels (process channels) "Join CHANNELS." @@ -1437,6 +1523,9 @@ if NICK is also on `rcirc-ignore-list-automatic'." (or (assq 'rcirc-low-priority-flag minor-mode-alist) (setq minor-mode-alist (cons '(rcirc-low-priority-flag " LowPri") minor-mode-alist))) +(or (assq 'rcirc-omit-mode minor-mode-alist) + (setq minor-mode-alist + (cons '(rcirc-omit-mode " Omit") minor-mode-alist))) (defun rcirc-toggle-ignore-buffer-activity () "Toggle the value of `rcirc-ignore-buffer-activity-flag'." @@ -1458,48 +1547,59 @@ if NICK is also on `rcirc-ignore-list-automatic'." "Activity in this buffer is normal priority")) (force-mode-line-update)) -(defvar rcirc-switch-to-buffer-function 'switch-to-buffer - "Function to use when switching buffers. -Possible values are `switch-to-buffer', `pop-to-buffer', and -`display-buffer'.") +(defun rcirc-omit-mode () + "Toggle the Rcirc-Omit mode. +If enabled, \"uninteresting\" lines are not shown. +Uninteresting lines are those whose responses are listed in +`rcirc-omit-responses'." + (interactive) + (setq rcirc-omit-mode (not rcirc-omit-mode)) + (let ((line (1- (count-screen-lines (point) (window-start))))) + (if rcirc-omit-mode + (progn + (add-to-invisibility-spec 'rcirc-omit) + (message "Rcirc-Omit mode enabled")) + (remove-from-invisibility-spec 'rcirc-omit) + (message "Rcirc-Omit mode disabled")) + (recenter line)) + (force-mode-line-update)) (defun rcirc-switch-to-server-buffer () "Switch to the server buffer associated with current channel buffer." (interactive) - (funcall rcirc-switch-to-buffer-function rcirc-server-buffer)) + (switch-to-buffer rcirc-server-buffer)) (defun rcirc-jump-to-first-unread-line () "Move the point to the first unread line in this buffer." (interactive) - (when (marker-position overlay-arrow-position) - (goto-char overlay-arrow-position))) - -(defvar rcirc-last-non-irc-buffer nil - "The buffer to switch to when there is no more activity.") + (if (marker-position overlay-arrow-position) + (goto-char overlay-arrow-position) + (message "No unread messages"))) + +(defun rcirc-non-irc-buffer () + (let ((buflist (buffer-list)) + buffer) + (while (and buflist (not buffer)) + (with-current-buffer (car buflist) + (unless (or (eq major-mode 'rcirc-mode) + (= ?\s (aref (buffer-name) 0)) ; internal buffers + (get-buffer-window (current-buffer))) + (setq buffer (current-buffer)))) + (setq buflist (cdr buflist))) + buffer)) (defun rcirc-next-active-buffer (arg) - "Go to the next rcirc buffer with activity. -With prefix ARG, go to the next low priority buffer with activity. -The function given by `rcirc-switch-to-buffer-function' is used to -show the buffer." + "Switch to the next rcirc buffer with activity. +With prefix ARG, go to the next low priority buffer with activity." (interactive "P") (let* ((pair (rcirc-split-activity rcirc-activity)) (lopri (car pair)) (hipri (cdr pair))) (if (or (and (not arg) hipri) (and arg lopri)) - (progn - (unless (eq major-mode 'rcirc-mode) - (setq rcirc-last-non-irc-buffer (current-buffer))) - (funcall rcirc-switch-to-buffer-function - (car (if arg lopri hipri)))) + (switch-to-buffer (car (if arg lopri hipri)) t) (if (eq major-mode 'rcirc-mode) - (if (not (and rcirc-last-non-irc-buffer - (buffer-live-p rcirc-last-non-irc-buffer))) - (message "No IRC activity. Start something.") - (message "No more IRC activity. Go back to work.") - (funcall rcirc-switch-to-buffer-function rcirc-last-non-irc-buffer) - (setq rcirc-last-non-irc-buffer nil)) + (switch-to-buffer (rcirc-non-irc-buffer)) (message (concat "No IRC activity." (when lopri @@ -1518,15 +1618,19 @@ activity. Only run if the buffer is not visible and (defun rcirc-record-activity (buffer &optional type) "Record BUFFER activity with TYPE." (with-current-buffer buffer - (when (not (get-buffer-window (current-buffer) t)) - (setq rcirc-activity - (sort (add-to-list 'rcirc-activity (current-buffer)) - (lambda (b1 b2) - (let ((t1 (with-current-buffer b1 rcirc-last-post-time)) - (t2 (with-current-buffer b2 rcirc-last-post-time))) - (time-less-p t2 t1))))) - (pushnew type rcirc-activity-types) - (rcirc-update-activity-string))) + (let ((old-activity rcirc-activity) + (old-types rcirc-activity-types)) + (when (not (get-buffer-window (current-buffer) t)) + (setq rcirc-activity + (sort (add-to-list 'rcirc-activity (current-buffer)) + (lambda (b1 b2) + (let ((t1 (with-current-buffer b1 rcirc-last-post-time)) + (t2 (with-current-buffer b2 rcirc-last-post-time))) + (time-less-p t2 t1))))) + (pushnew type rcirc-activity-types) + (unless (and (equal rcirc-activity old-activity) + (member type old-types)) + (rcirc-update-activity-string))))) (run-hook-with-args 'rcirc-activity-hooks buffer)) (defun rcirc-clear-activity (buffer) @@ -1535,6 +1639,12 @@ activity. Only run if the buffer is not visible and (with-current-buffer buffer (setq rcirc-activity-types nil))) +(defun rcirc-clear-unread (buffer) + "Erase the last read message arrow from BUFFER." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (set-marker overlay-arrow-position nil)))) + (defun rcirc-split-activity (activity) "Return a cons cell with ACTIVITY split into (lopri . hipri)." (let (lopri hipri) @@ -1546,6 +1656,9 @@ activity. Only run if the buffer is not visible and (add-to-list 'hipri buf t)))) (cons lopri hipri))) +(defvar rcirc-update-activity-string-hook nil + "Hook run whenever the activity string is updated.") + ;; TODO: add mouse properties (defun rcirc-update-activity-string () "Update mode-line string." @@ -1554,19 +1667,18 @@ activity. Only run if the buffer is not visible and (hipri (cdr pair))) (setq rcirc-activity-string (cond ((or hipri lopri) - (concat "-" - (and hipri "[") + (concat (and hipri "[") (rcirc-activity-string hipri) (and hipri lopri ",") (and lopri (concat "(" (rcirc-activity-string lopri) ")")) - (and hipri "]") - "-")) + (and hipri "]"))) ((not (null (rcirc-process-list))) - "-[]-") - (t ""))))) + "[]") + (t "[]"))) + (run-hooks 'rcirc-update-activity-string-hook))) (defun rcirc-activity-string (buffers) (mapconcat (lambda (b) @@ -1586,33 +1698,47 @@ activity. Only run if the buffer is not visible and (with-current-buffer buffer (or rcirc-short-buffer-name (buffer-name)))) -(defvar rcirc-current-buffer nil) -(defun rcirc-window-configuration-change () - "Go through visible windows and remove buffers from activity list. -Also, clear the overlay arrow if the current buffer is now hidden." - (let ((current-now-hidden t)) +(defun rcirc-visible-buffers () + "Return a list of the visible buffers that are in rcirc-mode." + (let (acc) (walk-windows (lambda (w) - (let ((buf (window-buffer w))) - (with-current-buffer buf - (when (eq major-mode 'rcirc-mode) - (rcirc-clear-activity buf))) - (when (eq buf rcirc-current-buffer) - (setq current-now-hidden nil))))) - ;; add overlay arrow if the buffer isn't displayed - (when (and current-now-hidden - rcirc-current-buffer - (buffer-live-p rcirc-current-buffer)) - (with-current-buffer rcirc-current-buffer - (when (and (eq major-mode 'rcirc-mode) - (marker-position overlay-arrow-position)) - (set-marker overlay-arrow-position nil))))) - - ;; remove any killed buffers from list - (setq rcirc-activity - (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf)) - rcirc-activity))) - (rcirc-update-activity-string) - (setq rcirc-current-buffer (current-buffer))) + (with-current-buffer (window-buffer w) + (when (eq major-mode 'rcirc-mode) + (push (current-buffer) acc))))) + acc)) + +(defvar rcirc-visible-buffers nil) +(defun rcirc-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 'rcirc-window-configuration-change-1))) + +(defun rcirc-window-configuration-change-1 () + ;; clear activity and overlay arrows + (let* ((old-activity rcirc-activity) + (hidden-buffers rcirc-visible-buffers)) + + (setq rcirc-visible-buffers (rcirc-visible-buffers)) + + (dolist (vbuf rcirc-visible-buffers) + (setq hidden-buffers (delq vbuf hidden-buffers)) + ;; clear activity for all visible buffers + (rcirc-clear-activity vbuf)) + + ;; clear unread arrow from recently hidden buffers + (dolist (hbuf hidden-buffers) + (rcirc-clear-unread hbuf)) + + ;; remove any killed buffers from list + (setq rcirc-activity + (delq nil (mapcar (lambda (buf) (when (buffer-live-p buf) buf)) + rcirc-activity))) + ;; update the mode-line string + (unless (equal old-activity rcirc-activity) + (rcirc-update-activity-string))) + + (remove-hook 'post-command-hook 'rcirc-window-configuration-change-1)) ;;; buffer name abbreviation @@ -1722,8 +1848,9 @@ Also, clear the overlay arrow if the current buffer is now hidden." (car (split-string channel))))) (rcirc-send-string process (concat "JOIN " channel)) (when (not (eq (selected-window) (minibuffer-window))) - (funcall rcirc-switch-to-buffer-function buffer)))) + (switch-to-buffer buffer)))) +;; TODO: /part #channel reason, or consider removing #channel altogether (defun-rcirc-command part (channel) "Part CHANNEL." (interactive "sPart channel: ") @@ -1902,7 +2029,7 @@ keywords when no KEYWORD is given." word-boundary)) (optional (and "/" - (1+ (char "-a-zA-Z0-9_=!?#$\@~`%&*+|\\/:;.,{}[]()")) + (1+ (char "-a-zA-Z0-9_='!?#$\@~`%&*+|\\/:;.,{}[]()")) (char "-a-zA-Z0-9_=#$\@~`%&*+|\\/:;{}[]()"))))) "Regexp matching URLs. Set to nil to disable URL features in rcirc.") @@ -1932,38 +2059,25 @@ keywords when no KEYWORD is given." (defvar rcirc-markup-text-functions - '(rcirc-markup-body-text - rcirc-markup-attributes + '(rcirc-markup-attributes rcirc-markup-my-nick rcirc-markup-urls rcirc-markup-keywords - rcirc-markup-bright-nicks) + rcirc-markup-bright-nicks + rcirc-markup-fill) + "List of functions used to manipulate text before it is printed. -Each function takes three arguments, PROCESS, SENDER, RESPONSE -and CHANNEL-BUFFER. The current buffer is temporary buffer that -contains the text to manipulate. Each function works on the text -in this buffer.") +Each function takes two arguments, SENDER, RESPONSE. The buffer +is narrowed with the text to be printed and the point is at the +beginning of the `rcirc-text' propertized text.") -(defun rcirc-markup-text (process sender response text) - "Return TEXT with properties added based on various patterns." - (let ((channel-buffer (current-buffer))) - (with-temp-buffer - (insert text) - (goto-char (point-min)) - (dolist (fn rcirc-markup-text-functions) - (save-excursion - (funcall fn process sender response channel-buffer))) - (buffer-substring (point-min) (point-max))))) +(defun rcirc-markup-timestamp (sender response) + (goto-char (point-min)) + (insert (rcirc-facify (format-time-string rcirc-time-format) + 'rcirc-timestamp))) -(defun rcirc-markup-body-text (process sender response channel-buffer) - ;; We add the text property `rcirc-text' to identify this as the - ;; body text. - (add-text-properties (point-min) (point-max) - (list 'rcirc-text (buffer-substring-no-properties - (point-min) (point-max))))) - -(defun rcirc-markup-attributes (process sender response channel-buffer) +(defun rcirc-markup-attributes (sender response) (while (re-search-forward "\\([\C-b\C-_\C-v]\\).*?\\(\\1\\|\C-o\\)" nil t) (rcirc-add-face (match-beginning 0) (match-end 0) (case (char-after (match-beginning 1)) @@ -1979,19 +2093,21 @@ in this buffer.") (while (re-search-forward "\C-o+" nil t) (delete-region (match-beginning 0) (match-end 0)))) -(defun rcirc-markup-my-nick (process sender response channel-buffer) +(defun rcirc-markup-my-nick (sender response) (with-syntax-table rcirc-nick-syntax-table - (while (re-search-forward (concat "\\b" - (regexp-quote (rcirc-nick process)) + (while (re-search-forward (concat "\\b" + (regexp-quote (rcirc-nick + (rcirc-buffer-process))) "\\b") nil t) (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-nick-in-message) (when (string= response "PRIVMSG") - (rcirc-add-face (point-min) (point-max) 'rcirc-nick-in-message-full-line) - (rcirc-record-activity channel-buffer 'nick))))) + (rcirc-add-face (point-min) (point-max) + 'rcirc-nick-in-message-full-line) + (rcirc-record-activity (current-buffer) 'nick))))) -(defun rcirc-markup-urls (process sender response channel-buffer) +(defun rcirc-markup-urls (sender response) (while (re-search-forward rcirc-url-regexp nil t) (let ((start (match-beginning 0)) (end (match-end 0))) @@ -1999,30 +2115,41 @@ in this buffer.") (add-text-properties start end (list 'mouse-face 'highlight 'keymap rcirc-browse-url-map)) ;; record the url - (let ((url (buffer-substring-no-properties start end))) - (with-current-buffer channel-buffer - (push url rcirc-urls)))))) - -(defun rcirc-markup-keywords (process sender response channel-buffer) - (let* ((target (with-current-buffer channel-buffer (or rcirc-target ""))) - (keywords (delq nil (mapcar (lambda (keyword) - (when (not (string-match keyword target)) - keyword)) - rcirc-keywords)))) - (when keywords - (while (re-search-forward (regexp-opt keywords 'words) nil t) - (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword) - (when (and (string= response "PRIVMSG") - (not (string= sender (rcirc-nick process)))) - (rcirc-record-activity channel-buffer 'keyword)))))) - -(defun rcirc-markup-bright-nicks (process sender response channel-buffer) + (push (buffer-substring-no-properties start end) rcirc-urls)))) + +(defun rcirc-markup-keywords (sender response) + (when (and (string= response "PRIVMSG") + (not (string= sender (rcirc-nick (rcirc-buffer-process))))) + (let* ((target (or rcirc-target "")) + (keywords (delq nil (mapcar (lambda (keyword) + (when (not (string-match keyword + target)) + keyword)) + rcirc-keywords)))) + (when keywords + (while (re-search-forward (regexp-opt keywords 'words) nil t) + (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-keyword) + (rcirc-record-activity (current-buffer) 'keyword)))))) + +(defun rcirc-markup-bright-nicks (sender response) (when (and rcirc-bright-nicks (string= response "NAMES")) (with-syntax-table rcirc-nick-syntax-table (while (re-search-forward (regexp-opt rcirc-bright-nicks 'words) nil t) (rcirc-add-face (match-beginning 0) (match-end 0) 'rcirc-bright-nick))))) + +(defun rcirc-markup-fill (sender response) + (when (not (string= response "372")) ; /motd + (let ((fill-prefix + (or rcirc-fill-prefix + (make-string (- (point) (line-beginning-position)) ?\s))) + (fill-column (cond ((eq rcirc-fill-column 'frame-width) + (1- (frame-width))) + (rcirc-fill-column + rcirc-fill-column) + (t fill-column)))) + (fill-region (point) (point-max) nil t)))) ;;; handlers ;; these are called with the server PROCESS, the SENDER, which is a @@ -2099,8 +2226,7 @@ in this buffer.") ;; if the buffer is still around, make it inactive (let ((buffer (rcirc-get-buffer process channel))) (when buffer - (with-current-buffer buffer - (setq rcirc-target nil)))))) + (rcirc-disconnect-buffer buffer))))) (defun rcirc-handler-PART (process sender args text) (let* ((channel (car args)) @@ -2169,7 +2295,7 @@ in this buffer.") (when rcirc-auto-authenticate-flag (rcirc-authenticate)))))) (defun rcirc-handler-PING (process sender args text) - (rcirc-send-string process (concat "PONG " (car args)))) + (rcirc-send-string process (concat "PONG :" (car args)))) (defun rcirc-handler-PONG (process sender args text) ;; do nothing @@ -2289,7 +2415,7 @@ Passwords are stored in `rcirc-authinfo' (which see)." process (concat "PRIVMSG chanserv :identify " - (cadr args) " " (car args)))) + (car args) " " (cadr args)))) ((equal method 'bitlbee) (rcirc-send-string process @@ -2314,7 +2440,8 @@ Passwords are stored in `rcirc-authinfo' (which see)." (format "%s sent unsupported ctcp: %s" sender text) t) (funcall handler process target sender args) - (if (not (string= request "ACTION")) + (unless (or (string= request "ACTION") + (string= request "KEEPALIVE")) (rcirc-print process sender "CTCP" target (format "%s" text) t)))))) diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index c1da9fb9132..efb5980766d 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -934,7 +934,7 @@ generate the completions list. This means that the hook (if pcomplete-last-window-config (let* ((cbuf (get-buffer "*Completions*")) (cwin (and cbuf (get-buffer-window cbuf)))) - (when (and cwin (window-live-p cwin)) + (when (window-live-p cwin) (bury-buffer cbuf) (set-window-configuration pcomplete-last-window-config)))) (setq pcomplete-last-window-config nil diff --git a/lisp/play/gamegrid.el b/lisp/play/gamegrid.el index a5689e6f0ea..0c49d81ec06 100644 --- a/lisp/play/gamegrid.el +++ b/lisp/play/gamegrid.el @@ -66,7 +66,8 @@ (defvar gamegrid-score-file-length 50 "Number of high scores to keep") -(defvar gamegrid-user-score-file-directory "~/.emacs.d/games" +(defvar gamegrid-user-score-file-directory + (concat user-emacs-directory "games") "A directory for game scores which can't be shared. If Emacs was built without support for shared game scores, then this directory will be used.") diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index d2e913f2315..5c117dffd5d 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1925,7 +1925,7 @@ Repeating the command scrolls the completion window." (interactive) (let ((window (get-buffer-window "*Completions*"))) (if (and (eq last-command this-command) - window (window-live-p window) (window-buffer window) + (window-live-p window) (window-buffer window) (buffer-name (window-buffer window))) (with-current-buffer (window-buffer window) (if (pos-visible-in-window-p (point-max) window) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 60fc4c43e7b..b29cf7fb141 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -235,7 +235,7 @@ (wsh . sh) (zsh . ksh88) (rpm . sh)) - "*Alist showing the direct ancestor of various shells. + "Alist showing the direct ancestor of various shells. This is the basis for `sh-feature'. See also `sh-alias-alist'. By default we have the following three hierarchies: @@ -270,7 +270,7 @@ sh Bourne Shell '((ksh . ksh88) (bash2 . bash) (sh5 . sh))) - "*Alist for transforming shell names to what they really are. + "Alist for transforming shell names to what they really are. Use this where the name of the executable doesn't correspond to the type of shell it really is." :type '(repeat (cons symbol symbol)) @@ -296,7 +296,7 @@ shell it really is." (file-name-sans-extension (downcase shell))))) (getenv "SHELL") "/bin/sh") - "*The executable file name for the shell being programmed." + "The executable file name for the shell being programmed." :type 'string :group 'sh-script) @@ -315,7 +315,7 @@ shell it really is." (wksh) ;; -f means don't run .zshrc. (zsh . "-f")) - "*Single argument string for the magic number. See `sh-feature'." + "Single argument string for the magic number. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") (choice (const :tag "No Arguments" nil) (string :tag "Arguments") @@ -324,8 +324,8 @@ shell it really is." (defcustom sh-imenu-generic-expression `((sh - . ((nil "^\\s-*\\(function\\s-+\\)?\\([A-Za-z_][A-Za-z_0-9]+\\)\\s-*()" 2)))) - "*Alist of regular expressions for recognizing shell function definitions. + . ((nil "^\\s-*\\(function\\s-+\\)?\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()" 2)))) + "Alist of regular expressions for recognizing shell function definitions. See `sh-feature' and `imenu-generic-expression'." :type '(alist :key-type (symbol :tag "Shell") :value-type (alist :key-type (choice :tag "Title" @@ -501,7 +501,7 @@ This is buffer-local in every such buffer.") '(shell-dynamic-complete-environment-variable shell-dynamic-complete-command comint-dynamic-complete-filename) - "*Functions for doing TAB dynamic completion." + "Functions for doing TAB dynamic completion." :type '(repeat function) :group 'sh-script) @@ -509,7 +509,7 @@ This is buffer-local in every such buffer.") (defcustom sh-require-final-newline '((csh . t) (pdksh . t)) - "*Value of `require-final-newline' in Shell-Script mode buffers. + "Value of `require-final-newline' in Shell-Script mode buffers. \(SHELL . t) means use the value of `mode-require-final-newline' for SHELL. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") @@ -519,12 +519,12 @@ See `sh-feature'." (defcustom sh-assignment-regexp - '((csh . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=") + '((csh . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=") ;; actually spaces are only supported in let/(( ... )) - (ksh88 . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=") - (rc . "\\<\\([a-zA-Z0-9_*]+\\)[ \t]*=") - (sh . "\\<\\([a-zA-Z0-9_]+\\)=")) - "*Regexp for the variable name and what may follow in an assignment. + (ksh88 . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=") + (rc . "\\<\\([[:alnum:]_*]+\\)[ \t]*=") + (sh . "\\<\\([[:alnum:]_]+\\)=")) + "Regexp for the variable name and what may follow in an assignment. First grouping matches the variable name. This is upto and including the `=' sign. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") @@ -540,7 +540,7 @@ sign. See `sh-feature'." (defcustom sh-remember-variable-min 3 - "*Don't remember variables less than this length for completing reads." + "Don't remember variables less than this length for completing reads." :type 'integer :group 'sh-script) @@ -551,16 +551,16 @@ That command is also used for setting this variable.") (defcustom sh-beginning-of-command - "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~a-zA-Z0-9:]\\)" - "*Regexp to determine the beginning of a shell command. + "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~[:alnum:]:]\\)" + "Regexp to determine the beginning of a shell command. The actual command starts at the beginning of the second \\(grouping\\)." :type 'regexp :group 'sh-script) (defcustom sh-end-of-command - "\\([/~a-zA-Z0-9:]\\)[ \t]*\\([;#)}`|&]\\|$\\)" - "*Regexp to determine the end of a shell command. + "\\([/~[:alnum:]:]\\)[ \t]*\\([;#)}`|&]\\|$\\)" + "Regexp to determine the end of a shell command. The actual command ends at the end of the first \\(grouping\\)." :type 'regexp :group 'sh-script) @@ -647,6 +647,7 @@ removed when closing the here document." (shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait") (wksh sh-append ksh88 + ;; FIXME: This looks too much like a regexp. --Stef "Xt[A-Z][A-Za-z]*") (zsh sh-append ksh88 @@ -656,7 +657,7 @@ removed when closing the here document." "readonly" "rehash" "sched" "setopt" "source" "suspend" "true" "ttyctl" "type" "unfunction" "unhash" "unlimit" "unsetopt" "vared" "which")) - "*List of all shell builtins for completing read and fontification. + "List of all shell builtins for completing read and fontification. Note that on some systems not all builtins are available or some are implemented as aliases. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") @@ -677,7 +678,7 @@ implemented as aliases. See `sh-feature'." (rc "else") (sh "!" "do" "elif" "else" "if" "then" "trap" "type" "until" "while")) - "*List of keywords that may be immediately followed by a builtin or keyword. + "List of keywords that may be immediately followed by a builtin or keyword. Given some confusion between keywords and builtins depending on shell and system, the distinction here has been based on whether they influence the flow of control or syntax. See `sh-feature'." @@ -716,7 +717,7 @@ flow of control or syntax. See `sh-feature'." (zsh sh-append bash "select")) - "*List of keywords not in `sh-leading-keywords'. + "List of keywords not in `sh-leading-keywords'. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") (choice (repeat string) @@ -837,18 +838,18 @@ See `sh-feature'.") (defvar sh-font-lock-keywords-var '((csh sh-append shell - ("\\${?[#?]?\\([A-Za-z_][A-Za-z0-9_]*\\|0\\)" 1 + ("\\${?[#?]?\\([[:alpha:]_][[:alnum:]_]*\\|0\\)" 1 font-lock-variable-name-face)) (es sh-append executable-font-lock-keywords - ("\\$#?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\)" 1 + ("\\$#?\\([[:alpha:]_][[:alnum:]_]*\\|[0-9]+\\)" 1 font-lock-variable-name-face)) (rc sh-append es) (bash sh-append shell ("\\$(\\(\\sw+\\)" (1 'sh-quoted-exec t) )) (sh sh-append shell ;; Variable names. - ("\\$\\({#?\\)?\\([A-Za-z_][A-Za-z0-9_]*\\|[-#?@!]\\)" 2 + ("\\$\\({#?\\)?\\([[:alpha:]_][[:alnum:]_]*\\|[-#?@!]\\)" 2 font-lock-variable-name-face) ;; Function names. ("^\\(\\sw+\\)[ \t]*(" 1 font-lock-function-name-face) @@ -861,8 +862,8 @@ See `sh-feature'.") (shell ;; Using font-lock-string-face here confuses sh-get-indent-info. ("\\(^\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\)$" 3 'sh-escaped-newline) - ("\\\\[^A-Za-z0-9]" 0 font-lock-string-face) - ("\\${?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\|[$*_]\\)" 1 + ("\\\\[^[:alnum:]]" 0 font-lock-string-face) + ("\\${?\\([[:alpha:]_][[:alnum:]_]*\\|[0-9]+\\|[$*_]\\)" 1 font-lock-variable-name-face)) (rpm sh-append rpm2 ("%{?\\(\\sw+\\)" 1 font-lock-keyword-face)) @@ -884,7 +885,7 @@ See `sh-feature'.") (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 + ;; 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\\)*.*") @@ -991,46 +992,38 @@ subshells can nest." (eq ?\" (nth 3 (syntax-ppss)))) ;; bingo we have a $( or a ` inside a "" (let ((char (char-after (point))) - (continue t) - (pos (point)) - (data nil) ;; value to put into match-data (and return) - (last nil) ;; last char seen - (bq (equal (match-string 1) "`")) ;; ` state flip-flop - (seen nil) ;; list of important positions - (nest 1)) ;; subshell nesting level - (while (and continue char (<= pos limit)) - ;; unescaped " inside a $( ... ) construct. - ;; state machine time... - ;; \ => ignore next char; - ;; ` => increase or decrease nesting level based on bq flag - ;; ) [where nesting > 0] => decrease nesting - ;; ( [where nesting > 0] => increase nesting - ;; ( [preceeded by $ ] => increase nesting - ;; " [nesting <= 0 ] => terminate, we're done. - ;; " [nesting > 0 ] => remember this, it's not a proper " - ;; FIXME: don't count parens that appear within quotes. - (cond - ((eq ?\\ last) nil) - ((eq ?\` char) (setq nest (+ nest (if bq -1 1)) bq (not bq))) - ((and (> nest 0) (eq ?\) char)) (setq nest (1- nest))) - ((and (eq ?$ last) (eq ?\( char)) (setq nest (1+ nest))) - ((and (> nest 0) (eq ?\( char)) (setq nest (1+ nest))) - ((eq char ?\") - (if (>= 0 nest) (setq continue nil) (push pos seen)))) - ;;(message "POS: %d [%d]" pos nest) - (setq last char - pos (1+ pos) - char (char-after pos)) ) - ;; FIXME: why construct a costly match data to pass to - ;; sh-apply-quoted-subshell rather than apply the highlight - ;; directly here? -- Stef - (when seen - ;;(message "SEEN: %S" seen) - (setq data (list (current-buffer))) - (dolist(P seen) - (setq data (cons P (cons (1+ P) data)))) - (store-match-data data)) - data) )) + ;; `state' can be: double-quote, backquote, code. + (state (if (eq (char-before) ?`) 'backquote 'code)) + ;; Stacked states in the context. + (states '(double-quote))) + (while (and state (progn (skip-chars-forward "^'\\\"`$()" limit) + (< (point) limit))) + ;; unescape " inside a $( ... ) construct. + (case (char-after) + (?\' (skip-chars-forward "^'" limit)) + (?\\ (forward-char 1)) + (?\" (case state + (double-quote (setq state (pop states))) + (t (push state states) (setq state 'double-quote))) + (if state (put-text-property (point) (1+ (point)) + 'syntax-table '(1)))) + (?\` (case state + (backquote (setq state (pop states))) + (t (push state states) (setq state 'backquote)))) + (?\$ (if (not (eq (char-after (1+ (point))) ?\()) + nil + (case state + (t (push state states) (setq state 'code))))) + (?\( (case state + (double-quote nil) + (t (push state states) (setq state 'code)))) + (?\) (case state + (double-quote nil) + (t (setq state (pop states))))) + (t (error "Internal error in sh-quoted-subshell"))) + (forward-char 1))) + t)) + (defun sh-is-quoted-p (pos) (and (eq (char-before pos) ?\\) @@ -1062,16 +1055,18 @@ subshells can nest." (when (save-excursion (backward-char 2) (looking-at ";;\\|in")) sh-st-punc))) -(defun sh-apply-quoted-subshell () - "Apply the `sh-st-punc' syntax to all the matches in `match-data'. -This is used to flag quote characters in subshell constructs inside strings -\(which should therefore not be treated as normal quote characters\)" - (let ((m (match-data)) a b) - (while m - (setq a (car m) - b (cadr m) - m (cddr m)) - (put-text-property a b 'syntax-table sh-st-punc))) sh-st-punc) +(defun sh-font-lock-backslash-quote () + (if (eq (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) ?\') + ;; In a '...' the backslash is not escaping. + sh-st-punc + nil)) + +(defun sh-font-lock-flush-syntax-ppss-cache (limit) + ;; This should probably be a standard function provided by font-lock.el + ;; (or syntax.el). + (syntax-ppss-flush-cache (point)) + (goto-char limit) + nil) (defconst sh-font-lock-syntactic-keywords ;; A `#' begins a comment when it is unquoted and at the beginning of a @@ -1080,7 +1075,11 @@ This is used to flag quote characters in subshell constructs inside strings ;; of the shell command language (under `quoting') but with `$' removed. `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol) ;; In a '...' the backslash is not escaping. - ("\\(\\\\\\)'" 1 ,sh-st-punc) + ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) + ;; The previous rule uses syntax-ppss, but the subsequent rules may + ;; change the syntax, so we have to tell syntax-ppss that the states it + ;; has just computed will need to be recomputed. + (sh-font-lock-flush-syntax-ppss-cache) ;; Make sure $@ and @? are correctly recognized as sexps. ("\\$\\([?@]\\)" 1 ,sh-st-symbol) ;; Find HEREDOC starters and add a corresponding rule for the ender. @@ -1095,8 +1094,7 @@ This is used to flag quote characters in subshell constructs inside strings (")" 0 (sh-font-lock-paren (match-beginning 0))) ;; highlight (possibly nested) subshells inside "" quoted regions correctly. ;; This should be at the very end because it uses syntax-ppss. - (sh-quoted-subshell - (1 (sh-apply-quoted-subshell) t t)))) + (sh-quoted-subshell))) (defun sh-font-lock-syntactic-face-function (state) (let ((q (nth 3 state))) @@ -1117,17 +1115,17 @@ and command `sh-reset-indent-vars-to-global-values'." (defcustom sh-set-shell-hook nil - "*Hook run by `sh-set-shell'." + "Hook run by `sh-set-shell'." :type 'hook :group 'sh-script) (defcustom sh-mode-hook nil - "*Hook run by `sh-mode'." + "Hook run by `sh-mode'." :type 'hook :group 'sh-script) (defcustom sh-learn-basic-offset nil - "*When `sh-guess-basic-offset' should learn `sh-basic-offset'. + "When `sh-guess-basic-offset' should learn `sh-basic-offset'. nil mean: never. t means: only if there seems to be an obvious value. @@ -1139,7 +1137,7 @@ Anything else means: whenever we have a \"good guess\" as to the value." :group 'sh-indentation) (defcustom sh-popup-occur-buffer nil - "*Controls when `sh-learn-buffer-indent' pops the `*indent*' buffer. + "Controls when `sh-learn-buffer-indent' pops the `*indent*' buffer. If t it is always shown. If nil, it is shown only when there are conflicts." :type '(choice @@ -1148,7 +1146,7 @@ are conflicts." :group 'sh-indentation) (defcustom sh-blink t - "*If non-nil, `sh-show-indent' shows the line indentation is relative to. + "If non-nil, `sh-show-indent' shows the line indentation is relative to. The position on the line is not necessarily meaningful. In some cases the line will be the matching keyword, but this is not always the case." @@ -1156,7 +1154,7 @@ always the case." :group 'sh-indentation) (defcustom sh-first-lines-indent 0 - "*The indentation of the first non-blank non-comment line. + "The indentation of the first non-blank non-comment line. Usually 0 meaning first column. Can be set to a number, or to nil which means leave it as is." :type '(choice @@ -1167,13 +1165,13 @@ Can be set to a number, or to nil which means leave it as is." (defcustom sh-basic-offset 4 - "*The default indentation increment. + "The default indentation increment. This value is used for the `+' and `-' symbols in an indentation variable." :type 'integer :group 'sh-indentation) (defcustom sh-indent-comment nil - "*How a comment line is to be indented. + "How a comment line is to be indented. nil means leave it as it is; t means indent it as a normal line, aligning it to previous non-blank non-comment line; @@ -1212,7 +1210,7 @@ a number means align to that column, e.g. 0 means fist column." :menu-tag "/ Indent left half sh-basic-offset"))) (defcustom sh-indent-for-else 0 - "*How much to indent an `else' relative to its `if'. Usually 0." + "How much to indent an `else' relative to its `if'. Usually 0." :type `(choice (integer :menu-tag "A number (positive=>indent right)" :tag "A number") @@ -1228,41 +1226,41 @@ a number means align to that column, e.g. 0 means fist column." sh-symbol-list)) (defcustom sh-indent-for-fi 0 - "*How much to indent a `fi' relative to its `if'. Usually 0." + "How much to indent a `fi' relative to its `if'. Usually 0." :type `(choice ,@ sh-number-or-symbol-list ) :group 'sh-indentation) (defcustom sh-indent-for-done 0 - "*How much to indent a `done' relative to its matching stmt. Usually 0." + "How much to indent a `done' relative to its matching stmt. Usually 0." :type `(choice ,@ sh-number-or-symbol-list ) :group 'sh-indentation) (defcustom sh-indent-after-else '+ - "*How much to indent a statement after an `else' statement." + "How much to indent a statement after an `else' statement." :type `(choice ,@ sh-number-or-symbol-list ) :group 'sh-indentation) (defcustom sh-indent-after-if '+ - "*How much to indent a statement after an `if' statement. + "How much to indent a statement after an `if' statement. This includes lines after `else' and `elif' statements, too, but does not affect the `else', `elif' or `fi' statements themselves." :type `(choice ,@ sh-number-or-symbol-list ) :group 'sh-indentation) (defcustom sh-indent-for-then 0 - "*How much to indent a `then' relative to its `if'." + "How much to indent a `then' relative to its `if'." :type `(choice ,@ sh-number-or-symbol-list ) :group 'sh-indentation) (defcustom sh-indent-for-do 0 - "*How much to indent a `do' statement. + "How much to indent a `do' statement. This is relative to the statement before the `do', typically a `while', `until', `for', `repeat' or `select' statement." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-after-do '+ - "*How much to indent a line after a `do' statement. + "How much to indent a line after a `do' statement. This is used when the `do' is the first word of the line. This is relative to the statement before the `do', typically a `while', `until', `for', `repeat' or `select' statement." @@ -1270,7 +1268,7 @@ This is relative to the statement before the `do', typically a :group 'sh-indentation) (defcustom sh-indent-after-loop-construct '+ - "*How much to indent a statement after a loop construct. + "How much to indent a statement after a loop construct. This variable is used when the keyword `do' is on the same line as the loop statement (e.g., `until', `while' or `for'). @@ -1280,7 +1278,7 @@ If the `do' is on a line by itself, then `sh-indent-after-do' is used instead." (defcustom sh-indent-after-done 0 - "*How much to indent a statement after a `done' keyword. + "How much to indent a statement after a `done' keyword. Normally this is 0, which aligns the `done' to the matching looping construct line. Setting it non-zero allows you to have the `do' statement on a line @@ -1289,55 +1287,55 @@ by itself and align the done under to do." :group 'sh-indentation) (defcustom sh-indent-for-case-label '+ - "*How much to indent a case label statement. + "How much to indent a case label statement. This is relative to the line containing the `case' statement." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-for-case-alt '++ - "*How much to indent statements after the case label. + "How much to indent statements after the case label. This is relative to the line containing the `case' statement." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-for-continuation '+ - "*How much to indent for a continuation statement." + "How much to indent for a continuation statement." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-after-open '+ - "*How much to indent after a line with an opening parenthesis or brace. + "How much to indent after a line with an opening parenthesis or brace. For an open paren after a function, `sh-indent-after-function' is used." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-after-function '+ - "*How much to indent after a function line." + "How much to indent after a function line." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) ;; These 2 are for the rc shell: (defcustom sh-indent-after-switch '+ - "*How much to indent a `case' statement relative to the `switch' statement. + "How much to indent a `case' statement relative to the `switch' statement. This is for the rc shell." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-indent-after-case '+ - "*How much to indent a statement relative to the `case' statement. + "How much to indent a statement relative to the `case' statement. This is for the rc shell." :type `(choice ,@ sh-number-or-symbol-list) :group 'sh-indentation) (defcustom sh-backslash-column 48 - "*Column in which `sh-backslash-region' inserts backslashes." + "Column in which `sh-backslash-region' inserts backslashes." :type 'integer :group 'sh) (defcustom sh-backslash-align t - "*If non-nil, `sh-backslash-region' will align backslashes." + "If non-nil, `sh-backslash-region' will align backslashes." :type 'boolean :group 'sh) @@ -1347,7 +1345,7 @@ This is for the rc shell." "Make a regexp which matches WORD as a word. This specifically excludes an occurrence of WORD followed by punctuation characters like '-'." - (concat word "\\([^-a-z0-9_]\\|$\\)")) + (concat word "\\([^-[:alnum:]_]\\|$\\)")) (defconst sh-re-done (sh-mkword-regexpr "done")) @@ -2234,6 +2232,7 @@ STRING This is ignored for the purposes of calculating (setq align-point (point)))) (or (bobp) (forward-char -1)) + ;; FIXME: This charset looks too much like a regexp. --Stef (skip-chars-forward "[a-z0-9]*?") ) ((string-match "[])}]" x) @@ -2442,7 +2441,7 @@ we go to the end of the previous line and do not check for continuations." (if (looking-at "[\"'`]") (sh-safe-forward-sexp) ;; (> (skip-chars-forward "^ \t\n\"'`") 0) - (> (skip-chars-forward "-_a-zA-Z$0-9") 0) + (> (skip-chars-forward "-_$[:alnum:]") 0) )) (buffer-substring start (point)) )) diff --git a/lisp/savehist.el b/lisp/savehist.el index 9555bce9bd4..9343fc2ccb1 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -101,8 +101,8 @@ minibuffer histories, such as `compile-command' or `kill-ring'." (cond ;; Backward compatibility with previous versions of savehist. ((file-exists-p "~/.emacs-history") "~/.emacs-history") - ((and (not (featurep 'xemacs)) (file-directory-p "~/.emacs.d/")) - "~/.emacs.d/history") + ((and (not (featurep 'xemacs)) (file-directory-p user-emacs-directory)) + (concat user-emacs-directory "history")) ((and (featurep 'xemacs) (file-directory-p "~/.xemacs/")) "~/.xemacs/history") ;; For users without `~/.emacs.d/' or `~/.xemacs/'. diff --git a/lisp/scroll-lock.el b/lisp/scroll-lock.el index 7075377d1b0..5896d6478eb 100644 --- a/lisp/scroll-lock.el +++ b/lisp/scroll-lock.el @@ -50,7 +50,7 @@ ;;;###autoload (define-minor-mode scroll-lock-mode - "Minor mode for pager-like scrolling. + "Buffer-local minor mode for pager-like scrolling. Keys which normally move point by line or paragraph will scroll the buffer by the respective amount of lines instead and point will be kept vertically fixed relative to window boundaries diff --git a/lisp/server.el b/lisp/server.el index 997a6c4fc6f..838aed96cf8 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -106,7 +106,7 @@ If set, the server accepts remote connections; otherwise it is local." :version "22.1") (put 'server-host 'risky-local-variable t) -(defcustom server-auth-dir "~/.emacs.d/server/" +(defcustom server-auth-dir (concat user-emacs-directory "server/") "Directory for server authentication files." :group 'server :type 'directory @@ -1183,8 +1183,7 @@ done that." (select-window win) (set-buffer next-buffer)) ;; Otherwise, let's find an appropriate window. - (cond ((and (windowp server-window) - (window-live-p server-window)) + (cond ((window-live-p server-window) (select-window server-window)) ((framep server-window) (unless (frame-live-p server-window) diff --git a/lisp/shell.el b/lisp/shell.el index a218981256a..9e07540d9d8 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -557,7 +557,7 @@ Otherwise, one argument `-i' is passed to the shell. (startfile (concat "~/.emacs_" name)) (xargs-name (intern-soft (concat "explicit-" name "-args")))) (unless (file-exists-p startfile) - (setq startfile (concat "~/.emacs.d/init_" name ".sh"))) + (setq startfile (concat user-emacs-directory "init_" name ".sh"))) (apply 'make-comint-in-buffer "shell" buffer prog (if (file-exists-p startfile) startfile) (if (and xargs-name (boundp xargs-name)) diff --git a/lisp/startup.el b/lisp/startup.el index 4c2ae272545..bbb594813a3 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -270,9 +270,9 @@ init file is read, in case it sets `mail-host-address'." (defcustom auto-save-list-file-prefix (cond ((eq system-type 'ms-dos) ;; MS-DOS cannot have initial dot, and allows only 8.3 names - "~/_emacs.d/auto-save.list/_s") + (concat user-emacs-directory "auto-save.list/_s")) (t - "~/.emacs.d/auto-save-list/.saves-")) + (concat user-emacs-directory "auto-save-list/.saves-"))) "Prefix for generating `auto-save-list-file-name'. This is used after reading your `.emacs' file to initialize `auto-save-list-file-name', by appending Emacs's pid and the system name, diff --git a/lisp/subr.el b/lisp/subr.el index 2215436fcec..22d92d2fb6c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2041,6 +2041,15 @@ On other systems, this variable is normally always nil.") (put 'cl-assertion-failed 'error-conditions '(error)) (put 'cl-assertion-failed 'error-message "Assertion failed") +(defconst user-emacs-directory + (if (eq system-type 'ms-dos) + ;; MS-DOS cannot have initial dot. + "~/_emacs.d/" + "~/.emacs.d/") + "Directory beneath which additional per-user Emacs-specific files are placed. +Various programs in Emacs store information in this directory. +Note that this should end with a directory separator.") + ;;;; Misc. useful functions. diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index 9c8827b0ae5..40ecf11d4e3 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -2255,7 +2255,7 @@ See also `mac-dnd-known-types'." (handler (cdr type-info)) (w (posn-window (event-start event)))) (when handler - (if (and (windowp w) (window-live-p w) + (if (and (window-live-p w) (not (window-minibuffer-p w)) (not (window-dedicated-p w))) ;; If dropping in an ordinary window which we could use, diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 699b87739d1..fe5d181ea21 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -269,7 +269,7 @@ See also `emacs-session-save'.") If the directory ~/.emacs.d exists, we make a filename in there, otherwise a file in the home directory." (let ((basename (concat "session." session-id)) - (emacs-dir "~/.emacs.d/")) + (emacs-dir user-emacs-directory)) (expand-file-name (if (file-directory-p emacs-dir) (concat emacs-dir basename) (concat "~/.emacs-" basename))))) diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el index f804fac5761..d664f758197 100644 --- a/lisp/term/xterm.el +++ b/lisp/term/xterm.el @@ -391,12 +391,305 @@ (substitute-key-definition [f59] [A-f11] local-function-key-map) (substitute-key-definition [f60] [A-f12] local-function-key-map) - ;; Use inheritance to let the main keymap override those defaults. - ;; This way we don't override terminfo-derived settings or settings - ;; made in the .emacs file. - (let ((m (copy-keymap xterm-function-map))) - (set-keymap-parent m (keymap-parent local-function-key-map)) - (set-keymap-parent local-function-key-map m))) + (let ((map (make-sparse-keymap))) + + ;; Use inheritance to let the main keymap override those defaults. + ;; This way we don't override terminfo-derived settings or settings + ;; made in the .emacs file. + (set-keymap-parent map (keymap-parent local-function-key-map)) + (set-keymap-parent local-function-key-map map) + + ;; xterm from X.org 6.8.2 uses these key definitions. + (define-key map "\eOP" [f1]) + (define-key map "\eOQ" [f2]) + (define-key map "\eOR" [f3]) + (define-key map "\eOS" [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]) + (define-key map "\e[23~" [f11]) + (define-key map "\e[24~" [f12]) + + (define-key map "\eO2P" [S-f1]) + (define-key map "\eO2Q" [S-f2]) + (define-key map "\eO2R" [S-f3]) + (define-key map "\eO2S" [S-f4]) + (define-key map "\e[1;2P" [S-f1]) + (define-key map "\e[1;2Q" [S-f2]) + (define-key map "\e[1;2R" [S-f3]) + (define-key map "\e[1;2S" [S-f4]) + (define-key map "\e[15;2~" [S-f5]) + (define-key map "\e[17;2~" [S-f6]) + (define-key map "\e[18;2~" [S-f7]) + (define-key map "\e[19;2~" [S-f8]) + (define-key map "\e[20;2~" [S-f9]) + (define-key map "\e[21;2~" [S-f10]) + (define-key map "\e[23;2~" [S-f11]) + (define-key map "\e[24;2~" [S-f12]) + + (define-key map "\eO5P" [C-f1]) + (define-key map "\eO5Q" [C-f2]) + (define-key map "\eO5R" [C-f3]) + (define-key map "\eO5S" [C-f4]) + (define-key map "\e[15;5~" [C-f5]) + (define-key map "\e[17;5~" [C-f6]) + (define-key map "\e[18;5~" [C-f7]) + (define-key map "\e[19;5~" [C-f8]) + (define-key map "\e[20;5~" [C-f9]) + (define-key map "\e[21;5~" [C-f10]) + (define-key map "\e[23;5~" [C-f11]) + (define-key map "\e[24;5~" [C-f12]) + + (define-key map "\eO6P" [C-S-f1]) + (define-key map "\eO6Q" [C-S-f2]) + (define-key map "\eO6R" [C-S-f3]) + (define-key map "\eO6S" [C-S-f4]) + (define-key map "\e[15;6~" [C-S-f5]) + (define-key map "\e[17;6~" [C-S-f6]) + (define-key map "\e[18;6~" [C-S-f7]) + (define-key map "\e[19;6~" [C-S-f8]) + (define-key map "\e[20;6~" [C-S-f9]) + (define-key map "\e[21;6~" [C-S-f10]) + (define-key map "\e[23;6~" [C-S-f11]) + (define-key map "\e[24;6~" [C-S-f12]) + + (define-key map "\eO3P" [A-f1]) + (define-key map "\eO3Q" [A-f2]) + (define-key map "\eO3R" [A-f3]) + (define-key map "\eO3S" [A-f4]) + (define-key map "\e[15;3~" [A-f5]) + (define-key map "\e[17;3~" [A-f6]) + (define-key map "\e[18;3~" [A-f7]) + (define-key map "\e[19;3~" [A-f8]) + (define-key map "\e[20;3~" [A-f9]) + (define-key map "\e[21;3~" [A-f10]) + (define-key map "\e[23;3~" [A-f11]) + (define-key map "\e[24;3~" [A-f12]) + + (define-key map "\eOA" [up]) + (define-key map "\eOB" [down]) + (define-key map "\eOC" [right]) + (define-key map "\eOD" [left]) + (define-key map "\eOF" [end]) + (define-key map "\eOH" [home]) + + (define-key map "\e[1;2A" [S-up]) + (define-key map "\e[1;2B" [S-down]) + (define-key map "\e[1;2C" [S-right]) + (define-key map "\e[1;2D" [S-left]) + (define-key map "\e[1;2F" [S-end]) + (define-key map "\e[1;2H" [S-home]) + + (define-key map "\e[1;5A" [C-up]) + (define-key map "\e[1;5B" [C-down]) + (define-key map "\e[1;5C" [C-right]) + (define-key map "\e[1;5D" [C-left]) + (define-key map "\e[1;5F" [C-end]) + (define-key map "\e[1;5H" [C-home]) + + (define-key map "\e[1;6A" [C-S-up]) + (define-key map "\e[1;6B" [C-S-down]) + (define-key map "\e[1;6C" [C-S-right]) + (define-key map "\e[1;6D" [C-S-left]) + (define-key map "\e[1;6F" [C-S-end]) + (define-key map "\e[1;6H" [C-S-home]) + + (define-key map "\e[1;3A" [A-up]) + (define-key map "\e[1;3B" [A-down]) + (define-key map "\e[1;3C" [A-right]) + (define-key map "\e[1;3D" [A-left]) + (define-key map "\e[1;3F" [A-end]) + (define-key map "\e[1;3H" [A-home]) + + (define-key map "\e[2~" [insert]) + (define-key map "\e[3~" [delete]) + (define-key map "\e[5~" [prior]) + (define-key map "\e[6~" [next]) + + (define-key map "\e[2;2~" [S-insert]) + (define-key map "\e[3;2~" [S-delete]) + (define-key map "\e[5;2~" [S-prior]) + (define-key map "\e[6;2~" [S-next]) + + (define-key map "\e[2;5~" [C-insert]) + (define-key map "\e[3;5~" [C-delete]) + (define-key map "\e[5;5~" [C-prior]) + (define-key map "\e[6;5~" [C-next]) + + (define-key map "\e[2;6~" [C-S-insert]) + (define-key map "\e[3;6~" [C-S-delete]) + (define-key map "\e[5;6~" [C-S-prior]) + (define-key map "\e[6;6~" [C-S-next]) + + (define-key map "\e[2;3~" [A-insert]) + (define-key map "\e[3;3~" [A-delete]) + (define-key map "\e[5;3~" [A-prior]) + (define-key map "\e[6;3~" [A-next]) + + (define-key map "\e[4~" [select]) + (define-key map "\e[29~" [print]) + + (define-key map "\eOj" [kp-multiply]) + (define-key map "\eOk" [kp-add]) + (define-key map "\eOl" [kp-separator]) + (define-key map "\eOm" [kp-subtract]) + (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]) + + ;; These keys are available in xterm starting from version 216 + ;; if the modifyOtherKeys resource is set to 1. + + (define-key map "\e[27;5;9~" [C-tab]) + (define-key map "\e[27;5;13~" [C-return]) + (define-key map "\e[27;5;39~" [?\C-\']) + (define-key map "\e[27;5;44~" [?\C-,]) + (define-key map "\e[27;5;45~" [?\C--]) + (define-key map "\e[27;5;46~" [?\C-.]) + (define-key map "\e[27;5;47~" [?\C-/]) + (define-key map "\e[27;5;48~" [?\C-0]) + (define-key map "\e[27;5;49~" [?\C-1]) + ;; Not all C-DIGIT keys have a distinct binding. + (define-key map "\e[27;5;57~" [?\C-9]) + (define-key map "\e[27;5;59~" [?\C-\;]) + (define-key map "\e[27;5;61~" [?\C-=]) + (define-key map "\e[27;5;92~" [?\C-\\]) + + (define-key map "\e[27;6;33~" [?\C-!]) + (define-key map "\e[27;6;34~" [?\C-\"]) + (define-key map "\e[27;6;35~" [?\C-#]) + (define-key map "\e[27;6;36~" [?\C-$]) + (define-key map "\e[27;6;37~" [?\C-%]) + (define-key map "\e[27;6;38~" [?\C-&]) + (define-key map "\e[27;6;40~" [?\C-\(]) + (define-key map "\e[27;6;41~" [?\C-\)]) + (define-key map "\e[27;6;42~" [?\C-*]) + (define-key map "\e[27;6;43~" [?\C-+]) + (define-key map "\e[27;6;58~" [?\C-:]) + (define-key map "\e[27;6;60~" [?\C-<]) + (define-key map "\e[27;6;62~" [?\C->]) + (define-key map "\e[27;6;63~" [(control ??)]) + + ;; These are the strings emitted for various C-M- combinations + ;; for keyboards that the Meta and Alt modifiers are on the same + ;; key (usually labeled "Alt"). + (define-key map "\e[27;13;9~" [C-M-tab]) + (define-key map "\e[27;13;13~" [C-M-return]) + + (define-key map "\e[27;13;39~" [?\C-\M-\']) + (define-key map "\e[27;13;44~" [?\C-\M-,]) + (define-key map "\e[27;13;45~" [?\C-\M--]) + (define-key map "\e[27;13;46~" [?\C-\M-.]) + (define-key map "\e[27;13;47~" [?\C-\M-/]) + (define-key map "\e[27;13;48~" [?\C-\M-0]) + (define-key map "\e[27;13;49~" [?\C-\M-1]) + (define-key map "\e[27;13;50~" [?\C-\M-2]) + (define-key map "\e[27;13;51~" [?\C-\M-3]) + (define-key map "\e[27;13;52~" [?\C-\M-4]) + (define-key map "\e[27;13;53~" [?\C-\M-5]) + (define-key map "\e[27;13;54~" [?\C-\M-6]) + (define-key map "\e[27;13;55~" [?\C-\M-7]) + (define-key map "\e[27;13;56~" [?\C-\M-8]) + (define-key map "\e[27;13;57~" [?\C-\M-9]) + (define-key map "\e[27;13;59~" [?\C-\M-\;]) + (define-key map "\e[27;13;61~" [?\C-\M-=]) + (define-key map "\e[27;13;92~" [?\C-\M-\\]) + + (define-key map "\e[27;14;33~" [?\C-\M-!]) + (define-key map "\e[27;14;34~" [?\C-\M-\"]) + (define-key map "\e[27;14;35~" [?\C-\M-#]) + (define-key map "\e[27;14;36~" [?\C-\M-$]) + (define-key map "\e[27;14;37~" [?\C-\M-%]) + (define-key map "\e[27;14;38~" [?\C-\M-&]) + (define-key map "\e[27;14;40~" [?\C-\M-\(]) + (define-key map "\e[27;14;41~" [?\C-\M-\)]) + (define-key map "\e[27;14;42~" [?\C-\M-*]) + (define-key map "\e[27;14;43~" [?\C-\M-+]) + (define-key map "\e[27;14;58~" [?\C-\M-:]) + (define-key map "\e[27;14;60~" [?\C-\M-<]) + (define-key map "\e[27;14;62~" [?\C-\M->]) + (define-key map "\e[27;14;63~" [(control meta ??)]) + + (define-key map "\e[27;7;9~" [C-M-tab]) + (define-key map "\e[27;7;13~" [C-M-return]) + + (define-key map "\e[27;7;32~" [?\C-\M-\s]) + (define-key map "\e[27;7;39~" [?\C-\M-\']) + (define-key map "\e[27;7;44~" [?\C-\M-,]) + (define-key map "\e[27;7;45~" [?\C-\M--]) + (define-key map "\e[27;7;46~" [?\C-\M-.]) + (define-key map "\e[27;7;47~" [?\C-\M-/]) + (define-key map "\e[27;7;48~" [?\C-\M-0]) + (define-key map "\e[27;7;49~" [?\C-\M-1]) + (define-key map "\e[27;7;50~" [?\C-\M-2]) + (define-key map "\e[27;7;51~" [?\C-\M-3]) + (define-key map "\e[27;7;52~" [?\C-\M-4]) + (define-key map "\e[27;7;53~" [?\C-\M-5]) + (define-key map "\e[27;7;54~" [?\C-\M-6]) + (define-key map "\e[27;7;55~" [?\C-\M-7]) + (define-key map "\e[27;7;56~" [?\C-\M-8]) + (define-key map "\e[27;7;57~" [?\C-\M-9]) + (define-key map "\e[27;7;59~" [?\C-\M-\;]) + (define-key map "\e[27;7;61~" [?\C-\M-=]) + (define-key map "\e[27;7;92~" [?\C-\M-\\]) + + (define-key map "\e[27;8;33~" [?\C-\M-!]) + (define-key map "\e[27;8;34~" [?\C-\M-\"]) + (define-key map "\e[27;8;35~" [?\C-\M-#]) + (define-key map "\e[27;8;36~" [?\C-\M-$]) + (define-key map "\e[27;8;37~" [?\C-\M-%]) + (define-key map "\e[27;8;38~" [?\C-\M-&]) + (define-key map "\e[27;8;40~" [?\C-\M-\(]) + (define-key map "\e[27;8;41~" [?\C-\M-\)]) + (define-key map "\e[27;8;42~" [?\C-\M-*]) + (define-key map "\e[27;8;43~" [?\C-\M-+]) + (define-key map "\e[27;8;58~" [?\C-\M-:]) + (define-key map "\e[27;8;60~" [?\C-\M-<]) + (define-key map "\e[27;8;62~" [?\C-\M->]) + (define-key map "\e[27;8;63~" [(control meta ??)]) + + (define-key map "\e[27;2;9~" [S-tab]) + (define-key map "\e[27;2;13~" [S-return]) + + (define-key map "\e[27;6;9~" [C-S-tab]) + (define-key map "\e[27;6;13~" [C-S-return]) + + ;; Other versions of xterm might emit 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 map "\e[1~" [home]) + + (define-key map "\eO2A" [S-up]) + (define-key map "\eO2B" [S-down]) + (define-key map "\eO2C" [S-right]) + (define-key map "\eO2D" [S-left]) + (define-key map "\eO2F" [S-end]) + (define-key map "\eO2H" [S-home]) + + (define-key map "\eO5A" [C-up]) + (define-key map "\eO5B" [C-down]) + (define-key map "\eO5C" [C-right]) + (define-key map "\eO5D" [C-left]) + (define-key map "\eO5F" [C-end]) + (define-key map "\eO5H" [C-home]) + + (define-key map "\e[11~" [f1]) + (define-key map "\e[12~" [f2]) + (define-key map "\e[13~" [f3]) + (define-key map "\e[14~" [f4])) (xterm-register-default-colors) ;; This recomputes all the default faces given the colors we've just set up. diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el new file mode 100644 index 00000000000..8afc92968d9 --- /dev/null +++ b/lisp/textmodes/bibtex-style.el @@ -0,0 +1,155 @@ +;;; bibtex-style.el --- Major mode for BibTeX Style files + +;; Copyright (C) 2005,2007 Free Software Foundation, Inc. + +;; Author: Stefan Monnier <monnier@iro.umontreal.ca> +;; Keywords: + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Done: font-lock, imenu, outline, commenting, indentation. +;; Todo: tab-completion. +;; Bugs: + +;;; Code: + +(defvar bibtex-style-mode-syntax-table + (let ((st (make-syntax-table))) + (modify-syntax-entry ?% "<" st) + (modify-syntax-entry ?\n ">" st) + (modify-syntax-entry ?\{ "(}" st) + (modify-syntax-entry ?\} "){" st) + (modify-syntax-entry ?\" "\"" st) + (modify-syntax-entry ?. "_" st) + (modify-syntax-entry ?' "'" st) + (modify-syntax-entry ?# "'" st) + (modify-syntax-entry ?* "." st) + (modify-syntax-entry ?= "." st) + (modify-syntax-entry ?$ "_" st) + st)) + + +(defconst bibtex-style-commands + '("ENTRY" "EXECUTE" "FUNCTION" "INTEGERS" "ITERATE" "MACRO" "READ" + "REVERSE" "SORT" "STRINGS")) + +(defconst bibtex-style-functions + ;; From http://www.eeng.dcu.ie/local-docs/btxdocs/btxhak/btxhak/node4.html. + '("<" ">" "=" "+" "-" "*" ":=" + "add.period$" "call.type$" "change.case$" "chr.to.int$" "cite$" + "duplicate$" "empty$" "format.name$" "if$" "int.to.chr$" "int.to.str$" + "missing$" "newline$" "num.names$" "pop$" "preamble$" "purify$" "quote$" + "skip$" "stack$" "substring$" "swap$" "text.length$" "text.prefix$" + "top$" "type$" "warning$" "while$" "width$" "write$")) + +(defvar bibtex-style-font-lock-keywords + `((,(regexp-opt bibtex-style-commands 'words) . font-lock-keyword-face) + ("\\w+\\$" . font-lock-keyword-face) + ("\\<\\(FUNCTION\\|MACRO\\)\\s-+{\\([^}\n]+\\)}" + (2 font-lock-function-name-face)))) + +;;;###autoload (add-to-list 'auto-mode-alist '("\\.bst\\'" . bibtex-style-mode)) + +;;;###autoload +(define-derived-mode bibtex-style-mode nil "BibStyle" + "Major mode for editing BibTeX style files." + (set (make-local-variable 'comment-start) "%") + (set (make-local-variable 'outline-regexp) "^[a-z]") + (set (make-local-variable 'imenu-generic-expression) + '((nil "\\<\\(FUNCTION\\|MACRO\\)\\s-+{\\([^}\n]+\\)}" 2))) + (set (make-local-variable 'indent-line-function) 'bibtex-style-indent-line) + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (setq font-lock-defaults + '(bibtex-style-font-lock-keywords nil t + ((?. . "w"))))) + +(defun bibtex-style-indent-line () + "Indent current line of BibTeX Style code." + (interactive) + (let* ((savep (point)) + (indent (condition-case nil + (save-excursion + (forward-line 0) + (skip-chars-forward " \t") + (if (>= (point) savep) (setq savep nil)) + (max (bibtex-style-calculate-indentation) 0)) + (error 0)))) + (if savep + (save-excursion (indent-line-to indent)) + (indent-line-to indent)))) + +(defcustom bibtex-style-indent-basic 2 + "Basic amount of indentation to use in BibTeX Style mode." + :type 'integer) + +(defun bibtex-style-calculate-indentation (&optional virt) + (or + ;; Stick the first line at column 0. + (and (= (point-min) (line-beginning-position)) 0) + ;; Commands start at column 0. + (and (looking-at (regexp-opt bibtex-style-commands 'words)) 0) + ;; Trust the current indentation, if such info is applicable. + (and virt (save-excursion (skip-chars-backward " \t{") (bolp)) + (current-column)) + ;; Put leading close-paren where the matching open brace would be. + (and (looking-at "}") + (condition-case nil + (save-excursion + (up-list -1) + (bibtex-style-calculate-indentation 'virt)) + (scan-error nil))) + ;; Align leading "if$" with previous command. + (and (looking-at "if\\$") + (condition-case nil + (save-excursion + (backward-sexp 3) + (bibtex-style-calculate-indentation 'virt)) + (scan-error + ;; There is no command before the "if$". + (condition-case nil + (save-excursion + (up-list -1) + (+ bibtex-style-indent-basic + (bibtex-style-calculate-indentation 'virt))) + (scan-error nil))))) + ;; Right after an opening brace. + (condition-case err (save-excursion (backward-sexp 1) nil) + (scan-error (goto-char (nth 2 err)) + (+ bibtex-style-indent-basic + (bibtex-style-calculate-indentation 'virt)))) + ;; Default, align with previous command. + (let ((fai ;; First arm of an "if$". + (condition-case nil + (save-excursion + (forward-sexp 2) + (forward-comment (point-max)) + (looking-at "if\\$")) + (scan-error nil)))) + (save-excursion + (condition-case err + (while (progn + (backward-sexp 1) + (save-excursion (skip-chars-backward " \t{") (not (bolp))))) + (scan-error nil)) + (+ (current-column) + (if (or fai (looking-at "ENTRY")) bibtex-style-indent-basic 0)))))) + + +(provide 'bibtex-style) +;; arch-tag: b20ad41a-fd36-466e-8fd2-cc6137f9c55c +;;; bibtex-style.el ends here diff --git a/lisp/textmodes/org-publish.el b/lisp/textmodes/org-publish.el index 74cd7096935..1afcee0182b 100644 --- a/lisp/textmodes/org-publish.el +++ b/lisp/textmodes/org-publish.el @@ -6,8 +6,6 @@ ;; Keywords: hypermedia, outlines ;; Version: 1.80 -;; $Id: org-publish.el,v 1.2 2007/06/07 02:04:17 miles Exp $ - ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index fd387a22c0f..416812dbbf5 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -67,7 +67,7 @@ "Determine the start and end buffer locations for the THING at point. THING is a symbol which specifies the kind of syntactic entity you want. Possibilities include `symbol', `list', `sexp', `defun', `filename', `url', -`word', `sentence', `whitespace', `line', `page' and others. +`email', `word', `sentence', `whitespace', `line', `page' and others. See the file `thingatpt.el' for documentation on how to define a symbol as a valid THING. @@ -124,7 +124,7 @@ of the textual entity that was found." "Return the THING at point. THING is a symbol which specifies the kind of syntactic entity you want. Possibilities include `symbol', `list', `sexp', `defun', `filename', `url', -`word', `sentence', `whitespace', `line', `page' and others. +`email', `word', `sentence', `whitespace', `line', `page' and others. See the file `thingatpt.el' for documentation on how to define a symbol as a valid THING." @@ -340,6 +340,33 @@ point." (goto-char (car bounds)) (error "No URL here"))))) +;; Email addresses +(defvar thing-at-point-email-regexp + "<?[-+_.~a-zA-Z][-+_.~:a-zA-Z0-9]*@[-.a-zA-Z0-9]+>?" + "A regular expression probably matching an email address. +This does not match the real name portion, only the address, optionally +with angle brackets.") + +;; Haven't set 'forward-op on 'email nor defined 'forward-email' because +;; not sure they're actually needed, and URL seems to skip them too. +;; Note that (end-of-thing 'email) and (beginning-of-thing 'email) +;; work automagically, though. + +(put 'email 'bounds-of-thing-at-point + (lambda () + (let ((thing (thing-at-point-looking-at thing-at-point-email-regexp))) + (if thing + (let ((beginning (match-beginning 0)) + (end (match-end 0))) + (cons beginning end)))))) + +(put 'email 'thing-at-point + (lambda () + (let ((boundary-pair (bounds-of-thing-at-point 'email))) + (if boundary-pair + (buffer-substring-no-properties + (car boundary-pair) (cdr boundary-pair)))))) + ;; Whitespace (defun forward-whitespace (arg) diff --git a/lisp/thumbs.el b/lisp/thumbs.el index 7df2d295c9e..56f4e45dcb3 100644 --- a/lisp/thumbs.el +++ b/lisp/thumbs.el @@ -67,7 +67,7 @@ :version "22.1" :group 'multimedia) -(defcustom thumbs-thumbsdir "~/.emacs.d/thumbs" +(defcustom thumbs-thumbsdir (concat user-emacs-directory "thumbs") "*Directory to store thumbnails." :type 'directory :group 'thumbs) diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 384b9b8415c..7c97579ab6e 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -623,8 +623,7 @@ with some explanatory links." (defun tutorial--saved-dir () "Directory to which tutorials are saved." - (expand-file-name "tutorial" - (if (eq system-type 'ms-dos) "~/_emacs.d/" "~/.emacs.d/"))) + (expand-file-name "tutorial" user-emacs-directory)) (defun tutorial--saved-file () "File name in which to save tutorials." diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index d9efd3a4540..bd0e4b2e4b1 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,18 @@ +2007-06-12 Tom Tromey <tromey@redhat.com> + + * url.el (url-configuration-directory): Use user-emacs-directory. + +2007-06-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * url-cookie.el (url-cookie-name, url-cookie-value) + (url-cookie-expires, url-cookie-localpart, url-cookie-domain) + (url-cookie-secure, url-cookie-set-name, url-cookie-set-value) + (url-cookie-set-expires, url-cookie-set-localpart) + (url-cookie-set-domain, url-cookie-set-secure) + (url-cookie-retrieve-arg, url-cookie-create, url-cookie-p): Remove. + (url-cookie): New struct. + (url-cookie-store): Use setf instead of url-cookie-set-*. + 2007-05-29 Chong Yidong <cyd@stupidchicken.com> * url-mailto.el (url-mailto): Insert body after diff --git a/lisp/url/url-cookie.el b/lisp/url/url-cookie.el index 8d729c92369..44ef8aed779 100644 --- a/lisp/url/url-cookie.el +++ b/lisp/url/url-cookie.el @@ -33,51 +33,6 @@ ;; See http://home.netscape.com/newsref/std/cookie_spec.html for the ;; 'open standard' defining this crap. -;; -;; A cookie is stored internally as a vector of 7 slots -;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ] - -(defsubst url-cookie-name (cookie) (aref cookie 1)) -(defsubst url-cookie-value (cookie) (aref cookie 2)) -(defsubst url-cookie-expires (cookie) (aref cookie 3)) -(defsubst url-cookie-localpart (cookie) (aref cookie 4)) -(defsubst url-cookie-domain (cookie) (aref cookie 5)) -(defsubst url-cookie-secure (cookie) (aref cookie 6)) - -(defsubst url-cookie-set-name (cookie val) (aset cookie 1 val)) -(defsubst url-cookie-set-value (cookie val) (aset cookie 2 val)) -(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val)) -(defsubst url-cookie-set-localpart (cookie val) (aset cookie 4 val)) -(defsubst url-cookie-set-domain (cookie val) (aset cookie 5 val)) -(defsubst url-cookie-set-secure (cookie val) (aset cookie 6 val)) -(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args))) - -(defsubst url-cookie-create (&rest args) - "Create a cookie vector object from keyword-value pairs ARGS. -The keywords allowed are - :name NAME - :value VALUE - :expires TIME - :localpart LOCALPAR - :domain DOMAIN - :secure ??? -Could someone fill in more information?" - (let ((retval (make-vector 7 nil))) - (aset retval 0 'cookie) - (url-cookie-set-name retval (url-cookie-retrieve-arg :name args)) - (url-cookie-set-value retval (url-cookie-retrieve-arg :value args)) - (url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args)) - (url-cookie-set-localpart retval (url-cookie-retrieve-arg :localpart args)) - (url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args)) - (url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args)) - retval)) - -(defun url-cookie-p (obj) - "Return non-nil if OBJ is a cookie vector object. -These objects represent cookies in the URL package. -A cookie vector object is a vector of 7 slots: - [cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE]." - (and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie))) (defgroup url-cookie nil "URL cookies." @@ -85,6 +40,20 @@ A cookie vector object is a vector of 7 slots: :prefix "url-cookie-" :group 'url) +;; A cookie is stored internally as a vector of 7 slots +;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ] + +(defstruct (url-cookie + (:constructor url-cookie-create) + (:copier nil) + ;; For compatibility with a previous version which did not use + ;; defstruct, and also in order to make sure that the printed + ;; representation does not depend on CL internals, we use an + ;; explicitly managed tag. + (:type vector)) + (tag 'cookie :read-only t) + name value expires localpart domain secure) + (defvar url-cookie-storage nil "Where cookies are stored.") (defvar url-cookie-secure-storage nil "Where secure cookies are stored.") (defcustom url-cookie-file nil @@ -199,8 +168,8 @@ telling Microsoft that." (if (and (equal localpart (url-cookie-localpart cur)) (equal name (url-cookie-name cur))) (progn - (url-cookie-set-expires cur expires) - (url-cookie-set-value cur value) + (setf (url-cookie-expires cur) expires) + (setf (url-cookie-value cur) value) (setq tmp t)))) (if (not tmp) ;; New cookie diff --git a/lisp/url/url.el b/lisp/url/url.el index a150733e40d..4cdf781e87f 100644 --- a/lisp/url/url.el +++ b/lisp/url/url.el @@ -50,7 +50,8 @@ (defvar url-configuration-directory (cond ((file-directory-p "~/.url") "~/.url") - ((file-directory-p "~/.emacs.d") "~/.emacs.d/url") + ((file-directory-p user-emacs-directory) + (concat user-emacs-directory "url")) (t "~/.url"))) (defun url-do-setup () diff --git a/lisp/vc-arch.el b/lisp/vc-arch.el index 488f9108d36..ede8c57ec98 100644 --- a/lisp/vc-arch.el +++ b/lisp/vc-arch.el @@ -62,7 +62,7 @@ ;;; (defvar vc-arch-command - (let ((candidates '("tla"))) + (let ((candidates '("tla" "baz"))) (while (and candidates (not (executable-find (car candidates)))) (setq candidates (cdr candidates))) (or (car candidates) "tla"))) diff --git a/lisp/vc-bzr.el b/lisp/vc-bzr.el new file mode 100644 index 00000000000..e5481b5f405 --- /dev/null +++ b/lisp/vc-bzr.el @@ -0,0 +1,569 @@ +;;; vc-bzr.el --- VC backend for the bzr revision control system + +;; Copyright (C) 2006, 2007 Free Software Foundation, Inc. + +;; NOTE: THIS IS A MODIFIED VERSION OF Dave Love's vc-bzr.el, +;; which you can find at: http://www.loveshack.ukfsn.org/emacs/vc-bzr.el +;; I could not get in touch with Dave Love by email, so +;; I am releasing my changes separately. -- Riccardo + +;; Author: Dave Love <fx@gnu.org>, Riccardo Murri <riccardo.murri@gmail.com> +;; Keywords: tools +;; Created: Sept 2006 +;; Version: 2007-01-17 +;; URL: http://launchpad.net/vc-bzr + +;; This file is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; This file is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + + +;;; Commentary: + +;; NOTE: THIS IS A MODIFIED VERSION OF Dave Love's vc-bzr.el, +;; which you can find at: http://www.loveshack.ukfsn.org/emacs/vc-bzr.el + +;; See <URL:http://bazaar-vcs.org/> concerning bzr. + +;; Load this library to register bzr support in VC. The support is +;; preliminary and incomplete, adapted from my darcs version. Lightly +;; exercised with bzr 0.8 and Emacs 21, and bzr 0.11 on Emacs 22. See +;; various Fixmes below. + +;; This should be suitable for direct inclusion in Emacs if someone +;; can persuade rms. + + +;;; Code: + +(eval-when-compile + (require 'vc)) ; for vc-exec-after + +(defgroup vc-bzr nil + "VC bzr backend." +;; :version "22" + :group 'vc) + +(defcustom vc-bzr-program "bzr" + "*Name of the bzr command (excluding any arguments)." + :group 'vc-bzr + :type 'string) + +;; Fixme: there's probably no call for this. +(defcustom vc-bzr-program-args nil + "*List of global arguments to pass to `vc-bzr-program'." + :group 'vc-bzr + :type '(repeat string)) + +(defcustom vc-bzr-diff-switches nil + "*String/list of strings specifying extra switches for bzr diff under VC." + :type '(choice (const :tag "None" nil) + (string :tag "Argument String") + (repeat :tag "Argument List" :value ("") string)) + :group 'vc-bzr) + +(defvar vc-bzr-version nil + "Internal use.") + +;; Could be used for compatibility checks if bzr changes. +(defun vc-bzr-version () + "Return a three-numeric element list with components of the bzr version. +This is of the form (X Y Z) for revision X.Y.Z. The elements are zero +if running `vc-bzr-program' doesn't produce the expected output." + (if vc-bzr-version + vc-bzr-version + (let ((s (shell-command-to-string + (concat (shell-quote-argument vc-bzr-program) " --version")))) + (if (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" s) + (setq vc-bzr-version (list (string-to-number (match-string 1 s)) + (string-to-number (match-string 2 s)) + (string-to-number (match-string 3 s)))) + '(0 0 0))))) + +(defun vc-bzr-at-least-version (vers) + "Return t if the bzr command reports being a least version VERS. +First argument VERS is a list of the form (X Y Z), as returned by `vc-bzr-version'." + (version-list-<= vers (vc-bzr-version))) + +;; XXX: vc-do-command is tailored for RCS and assumes that command-line +;; options precede the file name (ci -something file); with bzr, we need +; to pass options *after* the subcommand, e.g. bzr ls --versioned. +(defun vc-bzr-do-command* (buffer okstatus command &rest args) + "Execute bzr COMMAND, notifying user and checking for errors. +This is a wrapper around `vc-do-command', which see for detailed +explanation of arguments BUFFER, OKSTATUS and COMMAND. + +If the optional list of ARGS is present, its elements are +appended to the command line, in the order given. + +Unlike `vc-do-command', this has no way of telling which elements +in ARGS are file names and which are command-line options, so be +sure to pass absolute file names if needed. On the other hand, +you can mix options and file names in any order." + (apply 'vc-do-command buffer okstatus command nil args)) + +(cond + ((vc-bzr-at-least-version '(0 9)) + ;; since v0.9, bzr supports removing the progress indicators + ;; by setting environment variable BZR_PROGRESS_BAR to "none". + (defun vc-bzr-command (bzr-command buffer okstatus file &rest args) + "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND. +Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment." + (let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment))) + (apply 'vc-do-command buffer okstatus vc-bzr-program + file bzr-command (append vc-bzr-program-args args)))) + + (defun vc-bzr-command* (bzr-command buffer okstatus file &rest args) + "Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND. +Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment. +First argument BZR-COMMAND is passed as the first optional argument to +`vc-bzr-do-command*'." + (let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment))) + (apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program + bzr-command (append vc-bzr-program-args args))))) + + (t + ;; for older versions, we fall back to washing the log buffer + ;; when all output has been gathered. + (defun vc-bzr-command (command buffer okstatus file &rest args) + "Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND." + ;; Note: The ^Ms from the progress-indicator stuff that bzr prints + ;; on stderr cause auto-detection of a mac coding system on the + ;; stream for async output. bzr ought to be fixed to be able to + ;; suppress this. See also `vc-bzr-post-command-function'. (We + ;; can't sink the stderr output in `vc-do-command'.) + (apply 'vc-do-command buffer okstatus vc-bzr-program + file command (append vc-bzr-program-args args))) + + (defun vc-bzr-command* (command buffer okstatus &rest args) + "Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND." + (apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program + command file (append vc-bzr-program-args args))) + + (defun vc-bzr-post-command-function (command file flags) + "`vc-post-command-functions' function to remove progress messages." + ;; Note that using this requires that the vc command is run + ;; synchronously. Otherwise, the ^Ms in the leading progress + ;; message on stdout cause the stream to be interpreted as having + ;; DOS line endings, losing the ^Ms, so the search fails. I don't + ;; know how this works under Windows. + (when (equal command vc-bzr-program) + (save-excursion + (goto-char (point-min)) + (if (looking-at "^\\(\r.*\r\\)[^\r]+$") + (replace-match "" nil nil nil 1))) + (save-excursion + (goto-char (point-min)) + ;; This is inserted by bzr 0.11 `log', at least + (while (looking-at "read knit.*\n") + (replace-match ""))))) + + (add-hook 'vc-post-command-functions 'vc-bzr-post-command-function))) + +;; Fixme: If we're only interested in status messages, we only need +;; to set LC_MESSAGES, and we might need finer control of this. This +;; is moot anyhow, since bzr doesn't appear to be localized at all +;; (yet?). +(eval-when-compile +(defmacro vc-bzr-with-c-locale (&rest body) + "Run BODY with LC_ALL=C in the process environment. +This ensures that messages to be matched come out as expected." + `(let ((process-environment (cons "LC_ALL=C" process-environment))) + ,@body))) +(put 'vc-bzr-with-c-locale 'edebug-form-spec t) +(put 'vc-bzr-with-c-locale 'lisp-indent-function 0) + +(defun vc-bzr-bzr-dir (file) + "Return the .bzr directory in the hierarchy above FILE. +Return nil if there isn't one." + (setq file (expand-file-name file)) + (let ((dir (if (file-directory-p file) + file + (file-name-directory file))) + bzr) + (catch 'found + (while t + (setq bzr (expand-file-name ".bzr" dir)) ; fixme: "_bzr" on Doze?? + (if (file-directory-p bzr) + (throw 'found (file-name-as-directory bzr))) + (if (equal "" (file-name-nondirectory (directory-file-name dir))) + (throw 'found nil) + (setq dir (file-name-directory (directory-file-name dir)))))))) + +(defun vc-bzr-registered (file) + "Return non-nil if FILE is registered with bzr." + (if (vc-bzr-bzr-dir file) ; short cut + (vc-bzr-state file))) ; expensive + +(defun vc-bzr-state (file) + (let (ret state conflicts pending-merges) + (with-temp-buffer + (cd (file-name-directory file)) + (setq ret (vc-bzr-with-c-locale (vc-bzr-command "status" t 255 file))) + (goto-char 1) + (save-excursion + (when (re-search-forward "^conflicts:" nil t) + (message "Warning -- conflicts in bzr branch"))) + (save-excursion + (when (re-search-forward "^pending merges:" nil t) + (message "Warning -- pending merges in bzr branch"))) + (setq state + (cond ((not (equal ret 0)) nil) + ((looking-at "added\\|renamed\\|modified\\|removed") 'edited) + ;; Fixme: Also get this in a non-registered sub-directory. + ((looking-at "^$") 'up-to-date) + ;; if we're seeing this as first line of text, + ;; then the status is up-to-date, + ;; but bzr output only gives the warning to users. + ((looking-at "conflicts\\|pending") 'up-to-date) + ((looking-at "unknown\\|ignored") nil) + (t (error "Unrecognized output from `bzr status'")))) + (when (or conflicts pending-merges) + (message + (concat "Warning -- " + (if conflicts "conflicts ") + (if (and conflicts pending-merges) "and ") + (if pending-merges "pending merges ") + "in bzr branch"))) + (when state + (vc-file-setprop file 'vc-workfile-version + (vc-bzr-workfile-version file)) + (vc-file-setprop file 'vc-state state)) + state))) + +(defun vc-bzr-workfile-unchanged-p (file) + (eq 'up-to-date (vc-bzr-state file))) + +(defun vc-bzr-workfile-version (file) + (with-temp-buffer + (vc-bzr-command "revno" t 0 file) + (goto-char 1) + (buffer-substring 1 (line-end-position)))) + +(defun vc-bzr-checkout-model (file) + 'implicit) + +(defun vc-bzr-register (file &optional rev comment) + "Register FILE under bzr. +Signal an error unless REV is nil. +COMMENT is ignored." + (if rev (error "Can't register explicit version with bzr")) + (vc-bzr-command "add" nil 0 file)) + +;; Could run `bzr status' in the directory and see if it succeeds, but +;; that's relatively expensive. +(defun vc-bzr-responsible-p (file) + "Return non-nil if FILE is (potentially) controlled by bzr. +The criterion is that there is a `.bzr' directory in the same +or a superior directory." + (vc-bzr-bzr-dir file)) + +(defun vc-bzr-could-register (file) + "Return non-nil if FILE could be registered under bzr." + (and (vc-bzr-responsible-p file) ; shortcut + (condition-case () + (with-temp-buffer + (vc-bzr-command "add" t 0 file "--dry-run") + ;; The command succeeds with no output if file is + ;; registered (in bzr 0.8). + (goto-char 1) + (looking-at "added ")) + (error)))) + +(defun vc-bzr-unregister (file) + "Unregister FILE from bzr." + (vc-bzr-command "remove" nil 0 file)) + +(defun vc-bzr-checkin (file rev comment) + "Check FILE in to bzr with log message COMMENT. +REV non-nil gets an error." + (if rev (error "Can't check in a specific version with bzr")) + (vc-bzr-command "commit" nil 0 file "-m" comment)) + +(defun vc-bzr-checkout (file &optional editable rev destfile) + "Checkout revision REV of FILE from bzr to DESTFILE. +EDITABLE is ignored." + (unless destfile + (setq destfile (vc-version-backup-file-name file rev))) + (let ((coding-system-for-read 'binary) + (coding-system-for-write 'binary)) + (with-temp-file destfile + (if rev + (vc-bzr-command "cat" t 0 file "-r" rev) + (vc-bzr-command "cat" t 0 file))))) + +(defun vc-bzr-revert (file &optional contents-done) + (unless contents-done + (with-temp-buffer (vc-bzr-command "revert" t 'async file)))) + +(eval-when-compile + (defvar log-view-message-re) + (defvar log-view-file-re) + (defvar log-view-font-lock-keywords) + (defvar log-view-current-tag-function)) + +;; Grim hack to account for lack of an extension mechanism for +;; log-view. Should be fixed in VC... +(defun vc-bzr-view-log-function () + "To be added to `log-view-mode-hook' to set variables for bzr output. +Removes itself after running." + (remove-hook 'log-view-mode-hook 'vc-bzr-view-log-function) + (require 'add-log) + ;; Don't have file markers, so use impossible regexp. + (set (make-local-variable 'log-view-file-re) "\\'\\`") + (set (make-local-variable 'log-view-message-re) "^ *-+\n *\\(revno: [0-9]+\\|merged: .+\\)") + (set (make-local-variable 'log-view-font-lock-keywords) + `(("^ *committer: \ +\\([^<(]+?\\)[ ]*[(<]\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)[>)]" + nil nil + (1 'change-log-name-face nil t) + (2 'change-log-email-face nil t) + (3 'change-log-email-face nil t)) + ("^ *timestamp: \\(.*\\)" (1 'change-log-date-face)) + (,log-view-message-re . 'log-view-message-face) +;; ("^ \\(.*\\)$" (1 'log-view-message-face)) + ))) + +(defun vc-bzr-print-log (file &optional buffer) ; get buffer arg in Emacs 22 + "Get bzr change log for FILE into specified BUFFER." + ;; Fixme: VC needs a hook to sort out the mode for the buffer, or at + ;; least set the regexps right. + ;; Fixme: This might need the locale fixing up if things like `revno' + ;; got localized, but certainly it shouldn't use LC_ALL=C. + ;; NB. Can't be async -- see `vc-bzr-post-command-function'. + (vc-bzr-command "log" buffer 0 file) + (add-hook 'log-view-mode-hook 'vc-bzr-view-log-function)) + +(defun vc-bzr-show-log-entry (version) + "Find entry for patch name VERSION in bzr change log buffer." + (goto-char (point-min)) + (let (case-fold-search) + (if (re-search-forward (concat "^-+\nrevno: " version "$") nil t) + (beginning-of-line 0) + (goto-char (point-min))))) + +;; Fixem: vc-bzr-wash-log + +(autoload 'vc-diff-switches-list "vc" nil nil t) + +(defun vc-bzr-diff (file &optional rev1 rev2 buffer) + "VC bzr backend for diff." + (let ((working (vc-workfile-version file))) + (if (and (equal rev1 working) (not rev2)) + (setq rev1 nil)) + (if (and (not rev1) rev2) + (setq rev1 working)) + ;; NB. Can't be async -- see `vc-bzr-post-command-function'. + ;; bzr diff produces condition code 1 for some reason. + (apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 file + "--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr) + " ") + (when rev1 + (if rev2 + (list "-r" (format "%s..%s" rev1 rev2)) + (list "-r" rev1)))))) + +(defalias 'vc-bzr-diff-tree 'vc-bzr-diff) + +;; Fixme: implement vc-bzr-dir-state, vc-bzr-dired-state-info + +;; Fixme: vc-{next,previous}-version need fixing in vc.el to deal with +;; straight integer versions. + +(defun vc-bzr-delete-file (file) + "Delete FILE and delete it in the bzr repository." + (condition-case () + (delete-file file) + (file-error nil)) + (vc-bzr-command "remove" nil 0 file)) + +(defun vc-bzr-rename-file (old new) + "Rename file from OLD to NEW using `bzr mv'." + (vc-bzr-command "mv" nil 0 new old)) + +(defvar vc-bzr-annotation-table nil + "Internal use.") +(make-variable-buffer-local 'vc-bzr-annotation-table) + +(defun vc-bzr-annotate-command (file buffer &optional version) + "Prepare BUFFER for `vc-annotate' on FILE. +Each line is tagged with the revision number, which has a `help-echo' +property containing author and date information." + (apply #'vc-bzr-command "annotate" buffer 0 file "-l" "--all" + (if version (list "-r" version))) + (with-current-buffer buffer + ;; Store the tags for the annotated source lines in a hash table + ;; to allow saving space by sharing the text properties. + (setq vc-bzr-annotation-table (make-hash-table :test 'equal)) + (goto-char (point-min)) + (while (re-search-forward "^\\( *[0-9]+\\) \\(.+\\) +\\([0-9]\\{8\\}\\) |" + nil t) + (let* ((rev (match-string 1)) + (author (match-string 2)) + (date (match-string 3)) + (key (match-string 0)) + (tag (gethash key vc-bzr-annotation-table))) + (unless tag + (save-match-data + (string-match " +\\'" author) + (setq author (substring author 0 (match-beginning 0)))) + (setq tag (propertize rev 'help-echo (concat "Author: " author + ", date: " date) + 'mouse-face 'highlight)) + (puthash key tag vc-bzr-annotation-table)) + (replace-match "") + (insert tag " |"))))) + +;; Definition from Emacs 22 +(unless (fboundp 'vc-annotate-convert-time) +(defun vc-annotate-convert-time (time) + "Convert a time value to a floating-point number of days. +The argument TIME is a list as returned by `current-time' or +`encode-time', only the first two elements of that list are considered." + (/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600))) + +(defun vc-bzr-annotate-time () + (when (re-search-forward "^ *[0-9]+ |" nil t) + (let ((prop (get-text-property (line-beginning-position) 'help-echo))) + (string-match "[0-9]+\\'" prop) + (vc-annotate-convert-time + (encode-time 0 0 0 + (string-to-number (substring (match-string 0 prop) 6 8)) + (string-to-number (substring (match-string 0 prop) 4 6)) + (string-to-number (substring (match-string 0 prop) 0 4)) + ))))) + +(defun vc-bzr-annotate-extract-revision-at-line () + "Return revision for current line of annoation buffer, or nil. +Return nil if current line isn't annotated." + (save-excursion + (beginning-of-line) + (if (looking-at " *\\([0-9]+\\) | ") + (match-string-no-properties 1)))) + +;; Not needed for Emacs 22 +(defun vc-bzr-annotate-difference (point) + (let ((next-time (vc-bzr-annotate-time))) + (if next-time + (- (vc-annotate-convert-time (current-time)) next-time)))) + +;; FIXME: `bzr root' will return the real path to the repository root, +;; that is, it can differ from the buffer's current directory name +;; if there are any symbolic links. +(defun vc-bzr-root (dir) + "Return the root directory of the bzr repository containing DIR." + ;; Cache technique copied from vc-arch.el. + (or (vc-file-getprop dir 'bzr-root) + (vc-file-setprop + dir 'bzr-root + (substring + (shell-command-to-string (concat vc-bzr-program " root " dir)) 0 -1)))) + +;; TODO: it would be nice to mark the conflicted files in VC Dired, +;; and implement a command to run ediff and `bzr resolve' once the +;; changes have been merged. +(defun vc-bzr-dir-state (dir &optional localp) + "Find the VC state of all files in DIR. +Optional argument LOCALP is always ignored." + (let (at-start bzr-root-directory current-bzr-state current-vc-state) + ;; check that DIR is a bzr repository + (set 'bzr-root-directory (vc-bzr-root dir)) + (unless (string-match "^/" bzr-root-directory) + (error "Cannot find bzr repository for directory `%s'" dir)) + ;; `bzr ls --versioned' lists all versioned files; + ;; assume they are up-to-date, unless we are given + ;; evidence of the contrary. + (set 'at-start t) + (with-temp-buffer + (vc-bzr-command* "ls" t 0 "--versioned" "--non-recursive") + (goto-char (point-min)) + (while (or at-start + (eq 0 (forward-line))) + (set 'at-start nil) + (let ((file (expand-file-name + (buffer-substring-no-properties + (line-beginning-position) (line-end-position)) + bzr-root-directory))) + (vc-file-setprop file 'vc-state 'up-to-date) + ;; XXX: is this correct? what happens if one + ;; mixes different SCMs in the same dir? + (vc-file-setprop file 'vc-backend 'BZR)))) + ;; `bzr status' reports on added/modified/renamed and unknown/ignored files + (set 'at-start t) + (with-temp-buffer + (vc-bzr-with-c-locale (vc-bzr-command "status" t 0 nil)) + (goto-char (point-min)) + (while (or at-start + (eq 0 (forward-line))) + (set 'at-start nil) + (cond + ((looking-at "^added") + (set 'current-vc-state 'edited) + (set 'current-bzr-state 'added)) + ((looking-at "^modified") + (set 'current-vc-state 'edited) + (set 'current-bzr-state 'modified)) + ((looking-at "^renamed") + (set 'current-vc-state 'edited) + (set 'current-bzr-state 'renamed)) + ((looking-at "^\\(unknown\\|ignored\\)") + (set 'current-vc-state nil) + (set 'current-bzr-state 'not-versioned)) + ((looking-at " ") + ;; file names are indented by two spaces + (when current-vc-state + (let ((file (expand-file-name + (buffer-substring-no-properties + (match-end 0) (line-end-position)) + bzr-root-directory))) + (vc-file-setprop file 'vc-state current-vc-state) + (vc-file-setprop file 'vc-bzr-state current-bzr-state) + (when (eq 'added current-bzr-state) + (vc-file-setprop file 'vc-workfile-version "0")))) + (when (eq 'not-versioned current-bzr-state) + (let ((file (expand-file-name + (buffer-substring-no-properties + (match-end 0) (line-end-position)) + bzr-root-directory))) + (vc-file-setprop file 'vc-backend 'none) + (vc-file-setprop file 'vc-state nil)))) + (t + ;; skip this part of `bzr status' output + (set 'current-vc-state nil) + (set 'current-bzr-state nil))))))) + +(defun vc-bzr-dired-state-info (file) + "Bzr-specific version of `vc-dired-state-info'." + (if (eq 'edited (vc-state file)) + (let ((bzr-state (vc-file-getprop file 'vc-bzr-state))) + (if bzr-state + (concat "(" (symbol-name bzr-state) ")") + ;; else fall back to default vc representation + (vc-default-dired-state-info 'BZR file))))) + +;; In case of just `(load "vc-bzr")', but that's probably the wrong +;; way to do it. +(add-to-list 'vc-handled-backends 'BZR) + +(eval-after-load "vc" + '(add-to-list 'vc-directory-exclusion-list ".bzr" t)) + +(defconst vc-bzr-unload-hook + (lambda () + (setq vc-handled-backends (delq 'BZR vc-handled-backends)) + (remove-hook 'vc-post-command-functions 'vc-bzr-post-command-function))) + +(provide 'vc-bzr) +;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06 +;;; vc-bzr.el ends here diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index 1538a2a1ab3..b109f48d91d 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -464,11 +464,16 @@ NAME is assumed to be a URL." ;;; Internal functions ;;; +(defcustom vc-svn-program "svn" + "Name of the svn executable." + :type 'string + :group 'vc) + (defun vc-svn-command (buffer okstatus file &rest flags) "A wrapper around `vc-do-command' for use in vc-svn.el. The difference to vc-do-command is that this function always invokes `svn', and that it passes `vc-svn-global-switches' to it before FLAGS." - (apply 'vc-do-command buffer okstatus "svn" file + (apply 'vc-do-command buffer okstatus vc-svn-program file (if (stringp vc-svn-global-switches) (cons vc-svn-global-switches flags) (append vc-svn-global-switches diff --git a/lisp/vc.el b/lisp/vc.el index a65e698669e..d5c53a15a76 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -2096,7 +2096,7 @@ See Info node `Merging'." (define-key vmap "t" 'vc-dired-toggle-terse-mode) map)) -(define-derived-mode vc-dired-mode dired-mode "Dired under VC" +(define-derived-mode vc-dired-mode dired-mode "Dired under " "The major mode used in VC directory buffers. It works like Dired, but lists only files under version control, with @@ -2156,6 +2156,8 @@ There is a special command, `*l', to mark all files currently locked." (set (make-local-variable 'dired-actual-switches) vc-dired-switches)) (set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display) + (setq mode-name (concat mode-name (symbol-name (vc-responsible-backend + default-directory)))) (setq vc-dired-mode t)) (defun vc-dired-toggle-terse-mode () @@ -2214,7 +2216,9 @@ Called by dired after any portion of a vc-dired buffer has been read in." ;; if the backend supports it, get the state ;; of all files in this directory at once (let ((backend (vc-responsible-backend subdir))) - (if (vc-find-backend-function backend 'dir-state) + ;; check `backend' can really handle `subdir'. + (if (and (vc-call-backend backend 'responsible-p subdir) + (vc-find-backend-function backend 'dir-state)) (vc-call-backend backend 'dir-state subdir))) (forward-line 1) ;; erase (but don't remove) the "total" line diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 4c560918594..a69ebdc85e9 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -1491,6 +1491,8 @@ If that does not exists, call the value of `widget-complete-field'." (delete-backward-char 1)) (insert ?\n) (setq doc-end (point))))) + ((eq escape ?h) + (widget-add-documentation-string-button widget)) ((eq escape ?v) (if (and button-begin (not button-end)) (widget-apply widget :value-create) @@ -1516,44 +1518,7 @@ If that does not exists, call the value of `widget-complete-field'." (widget-clear-undo)) (defun widget-default-format-handler (widget escape) - ;; We recognize the %h escape by default. - (let* ((buttons (widget-get widget :buttons))) - (cond ((eq escape ?h) - (let* ((doc-property (widget-get widget :documentation-property)) - (doc-try (cond ((widget-get widget :doc)) - ((functionp doc-property) - (funcall doc-property - (widget-get widget :value))) - ((symbolp doc-property) - (documentation-property - (widget-get widget :value) - doc-property)))) - (doc-text (and (stringp doc-try) - (> (length doc-try) 1) - doc-try)) - (doc-indent (widget-get widget :documentation-indent))) - (when doc-text - (and (eq (preceding-char) ?\n) - (widget-get widget :indent) - (insert-char ?\s (widget-get widget :indent))) - ;; The `*' in the beginning is redundant. - (when (eq (aref doc-text 0) ?*) - (setq doc-text (substring doc-text 1))) - ;; Get rid of trailing newlines. - (when (string-match "\n+\\'" doc-text) - (setq doc-text (substring doc-text 0 (match-beginning 0)))) - (push (widget-create-child-and-convert - widget 'documentation-string - :indent (cond ((numberp doc-indent ) - doc-indent) - ((null doc-indent) - nil) - (t 0)) - doc-text) - buttons)))) - (t - (error "Unknown escape `%c'" escape))) - (widget-put widget :buttons buttons))) + (error "Unknown escape `%c'" escape)) (defun widget-default-button-face-get (widget) ;; Use :button-face or widget-button-face @@ -1665,13 +1630,32 @@ If that does not exists, call the value of `widget-complete-field'." (widget-default-action widget event)) (defun widget-default-prompt-value (widget prompt value unbound) - "Read an arbitrary value. Stolen from `set-variable'." -;; (let ((initial (if unbound -;; nil -;; It would be nice if we could do a `(cons val 1)' here. -;; (prin1-to-string (custom-quote value)))))) + "Read an arbitrary value." (eval-minibuffer prompt)) +(defun widget-docstring (widget) + "Return the documentation string specificied by WIDGET, or nil if none. +If WIDGET has a `:doc' property, that specifies the documentation string. +Otherwise, try the `:documentation-property' property. If this +is a function, call it with the widget's value as an argument; if +it is a symbol, use this symbol together with the widget's value +as the argument to `documentation-property'." + (let ((doc (or (widget-get widget :doc) + (let ((doc-prop (widget-get widget :documentation-property)) + (value (widget-get widget :value))) + (cond ((functionp doc-prop) + (funcall doc-prop value)) + ((symbolp doc-prop) + (documentation-property value doc-prop))))))) + (when (and (stringp doc) (> (length doc) 0)) + ;; Remove any redundant `*' in the beginning. + (when (eq (aref doc 0) ?*) + (setq doc (substring doc 1))) + ;; Remove trailing newlines. + (when (string-match "\n+\\'" doc) + (setq doc (substring doc 0 (match-beginning 0)))) + doc))) + ;;; The `item' Widget. (define-widget 'item 'default @@ -2913,7 +2897,8 @@ link for that string." "A documentation string." :format "%v" :action 'widget-documentation-string-action - :value-create 'widget-documentation-string-value-create) + :value-create 'widget-documentation-string-value-create + :visibility-widget 'visibility) (defun widget-documentation-string-value-create (widget) ;; Insert documentation string. @@ -2929,7 +2914,7 @@ link for that string." (widget-documentation-link-add widget start (point)) (setq button (widget-create-child-and-convert - widget 'visibility + widget (widget-get widget :visibility-widget) :help-echo "Show or hide rest of the documentation." :on "Hide Rest" :off "More" @@ -2954,6 +2939,29 @@ link for that string." (not (widget-get parent :documentation-shown)))) ;; Redraw. (widget-value-set widget (widget-value widget))) + +(defun widget-add-documentation-string-button (widget &rest args) + "Insert a new `documentation-string' widget based on WIDGET. +The new widget becomes a child of WIDGET, and is also added to +its `:buttons' list. The documentation string is found from +WIDGET using the function `widget-docstring'. +Optional ARGS specifies additional keyword arguments for the +`documentation-string' widget." + (let ((doc (widget-docstring widget)) + (indent (widget-get widget :indent)) + (doc-indent (widget-get widget :documentation-indent))) + (when doc + (and (eq (preceding-char) ?\n) + indent + (insert-char ?\s indent)) + (unless (or (numberp doc-indent) (null doc-indent)) + (setq doc-indent 0)) + (widget-put widget :buttons + (cons (apply 'widget-create-child-and-convert + widget 'documentation-string + :indent doc-indent + (nconc args (list doc))) + (widget-get widget :buttons)))))) ;;; The Sexp Widgets. diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 055e4305d9f..004fa1a42ef 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -172,7 +172,7 @@ FRAME-OR-WINDOW is the frame or window that the mouse is over." WINDOW is the window the mouse is over. ACTION is the suggested action from the source. If nothing has changed, return the last action and type we got from `x-dnd-test-function'." - (let ((buffer (when (and (windowp window) (window-live-p window)) + (let ((buffer (when (window-live-p window) (window-buffer window))) (current-state (x-dnd-get-state-for-frame window))) (when (or (not (equal buffer (aref current-state 0))) @@ -207,9 +207,7 @@ EXTRA-DATA is data needed for a specific protocol." (when types (aset current-state 2 types)) (when extra-data (aset current-state 6 extra-data)) (aset current-state 1 window) - (aset current-state 0 (if (and (windowp window) - (window-live-p window)) - (window-buffer window) nil)) + (aset current-state 0 (and (window-live-p window) (window-buffer window))) (setcdr (x-dnd-get-state-cons-for-frame window) current-state))) @@ -320,7 +318,7 @@ nil if not." (action (aref state 5)) (w (posn-window (event-start event)))) (when handler - (if (and (windowp w) (window-live-p w) + (if (and (window-live-p w) (not (window-minibuffer-p w)) (not (window-dedicated-p w))) ;; If dropping in an ordinary window which we could use, |