diff options
Diffstat (limited to 'lisp')
57 files changed, 2509 insertions, 947 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 32b8304044f..22690ba2694 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,225 @@ +2006-04-18 Dan Nicolaescu <dann@ics.uci.edu> + + * progmodes/python.el (python-mode): Fix typo. + +2006-04-18 J.D. Smith <jdsmith@as.arizona.edu> + + * comint.el (comint-previous-input): Don't clobber input line + when moving off either end of the input history ring. + (comint-delete-input): New function, used by + `comint-previous-input' and others. + (comint-previous-matching-input): Use + `coming-delete-input'. Save the partial input if leaving the + edit line. Goto point-max before deleting input to avoid + partial input fragments hanging around. + (comint-restore-input): New function, used by + `comint-previous-input', and bound to "C-c C-j". + +2006-04-18 Luc Teirlinck <teirllm@auburn.edu> + + * imenu.el (imenu--index-alist): Balance parentheses. + +2006-04-18 Dan Nicolaescu <dann@ics.uci.edu> + + * progmodes/python.el (python-mode): Add support for + hs-minor-mode. + +2006-04-19 Reiner Steib <Reiner.Steib@gmx.de> + + * abbrev.el (read-abbrev-file): Use abbrev-file-name if optional + file is nil. + +2006-04-18 Richard Stallman <rms@gnu.org> + + * tooltip.el (tooltip-mode, tooltip-use-echo-area): Doc fixes. + + * imenu.el (imenu-create-index-function, imenu--index-alist) + (imenu--last-menubar-index-alist, imenu--make-index-alist) + (imenu-default-create-index-function, imenu--generic-function): + Doc fixes. + + * image-mode.el (image-toggle-display): Handle tar and arc subfiles. + + * help-mode.el (help-mode): Set view-exit-action to delete window. + + * env.el (setenv): Get rid of arg UNSET. Interactive unsetting + now works by passing nil as arg. + + * apropos.el (apropos-print): Don't do where-is on self-insert-command. + + * abbrev.el (edit-abbrevs-redefine): Temporarily widen. + (read-abbrev-file): Provide default when reading filename. + + * files.el (enable-local-variables): Allow :all as value. + (hack-local-variables): Implement that value. + (safe-local-variable-values, safe-local-eval-forms) + (enable-local-variables): Mark as risky. + (find-file-visit-truename, kept-old-versions): Mark safe. + + * time-stamp.el (time-stamp-format, time-stamp-line-limit) + (time-stamp-start, time-stamp-end, time-stamp-inserts-lines) + (time-stamp-count, time-stamp-pattern): Add safe-local-variable prop. + +2006-04-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/tcl.el (tcl-send-string, tcl-send-region): + Use forward-line so as to get to BOL even in the presence of fields. + (tcl-eval-region): Strip surrounding space to avoid multiple prompts + in return. + (inferior-tcl): Tell tclsh to work in interactive mode. + + * complete.el (partial-completion-mode): + Use 'choose-completion-string-functions to make sure that + choose-completion fills the minibuffer properly. + + * complete.el (PC-old-read-file-name-internal): Remove. + (PC-read-include-file-name-internal): Remove. Turn it into an advice + of read-file-name-internal. + (partial-completion-mode): Enable/disable this advice. + +2006-04-18 Juanma Barranquero <lekktu@gmail.com> + + * net/tramp.el (tramp-completion-file-name-handler): Revert change + of 2006-04-17. + +2006-04-18 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el (org-insert-heading): Insert heading before + current if at beginning of line. + (org-todo, org-date): New faces. + (org-table-align): Make sure tooltip window contains full text. + (org-no-properties): New defsubst. + (org-set-font-lock-defaults): Use new faces. + +2006-04-18 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gud.el (gud-speedbar-item-info): Display frame address + for root variables. + + * progmodes/gdb-ui.el (gdb-pc-address): Rename from gdb-frame-address. + (gdb-frame-address): Re-use to identify frame for watch expression. + (gdb-var-list, gdb-var-create-handler): Add frame address for root + variables. + (gdb-init-1, gdb-source, gdb-post-prompt, ) + (gdb-assembler-custom, gdb-invalidate-assembler): Use gdb-pc-address. + (gdb-frame-handler): Get gdb-frame-address. + +2006-04-17 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.0.53. + + * net/tramp.el (tramp-completion-mode): ?\t has event-modifier + 'control. Reported by Matthias F,bv(Brste <slashdevslashnull@gmx.net>. + (tramp-completion-file-name-handler): Add autoload cookie for + adding to `file-name-handler-alist'. + + * net/tramp-smb.el (tramp-smb-wait-for-output): Wait always for + the prompt. If it returns earlier (when detecting an error + message), the rest of the output will merge accidently with the + output of the next command. Reported by M Jared Finder + <jared@hpalace.com>. + + * net/tramp-vc.el (vc-user-login-name): Wrap defadvice with a test + for `process-file', in order to let it work for older Emacsen too. + +2006-04-17 Ralf Angeli <angeli@iwi.uni-sb.de> + + * textmodes/tex-mode.el (tex-font-lock-match-suscript): New function. + (tex-font-lock-keywords-3): Use it. + +2006-04-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * newcomment.el (comment-add): New function. + (comment-region-default, comment-dwim): Use it. + +2006-04-15 Michael Olson <mwolson@gnu.org> + + * emacs-lisp/tq.el: Improve comments. + (tq-queue-head-question): New accessor function. + (tq-queue-head-regexp, tq-queue-head-closure, tq-queue-head-fn): + Update for modified queue structure. + (tq-queue-add): Accept `question' argument. + (tq-queue-pop): If a question is pending, send it. + (tq-enqueue): Accept new optional argument `delay-question'. + If this is non-nil, and at least one other question is pending a + response, queue the question rather than sending it immediately. + +2006-04-15 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> + + * calendar/appt.el (appt-add): Check whether an appointment is + already present in appt-time-msg-list. Simplify code. + +2006-04-14 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/cc-langs.el (c-mode-menu): + Don't presume c-subword-mode is bound. + +2006-04-13 Bill Wohler <wohler@newt.com> + + * cus-edit.el (customize-package-emacs-version-alist): Update docstring. + (customize-package-emacs-version): Use cdr instead of cadr now + that alists use dotted pairs. + + * custom.el (defcustom): Fix docstring for :package-version. + +2006-04-13 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-display-shell-command-buffer): New defvar. + (tramp-handle-shell-command): Display output buffer only when + `tramp-display-shell-command-buffer' is true. + (tramp-handle-process-file): Set `tramp-display-shell-command-buffer'. + +2006-04-13 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el (org-set-autofill-regexps): Set only the local + values of `adaptive-fill-regexp' and `adaptive-fill-function'. + +2006-04-13 Romain Francoise <romain@orebokech.com> + + * pcvs-parse.el (cvs-parse-table): Use `with-temp-buffer' to avoid + leaving temporary .cvsignore buffers behind. + +2006-04-13 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: (org-set-regexps-and-options) + (org-get-current-options): Better names for the startup folding + options. + +2006-04-13 Thien-Thi Nguyen <ttn@gnu.org> + + * vc.el (vc-annotate): Arrange for point to end up at the same + line number as in the original, but only when using a new buffer. + +2006-04-12 Davis Herring <herring@lanl.gov> (tiny change) + + * files.el (hack-one-local-variable-eval-safep): + Recognize `edebug-form-spec' for `put', but only if it passes + `edebug-basic-spec'. Generalize `put' handling. + + * emacs-lisp/edebug.el (edebug-basic-spec): New function for + vetting file-local form specs. + + * allout.el (allout-layout): Autoload its `safe-local-variable' + property. + +2006-04-13 Carsten Dominik <dominik@science.uva.nl> + + * textmodes/org.el: (org-ctrl-c-ctrl-c): Improve documentation string. + (org-agenda-mouse-1-follows-link) + (org-mouse-1-follows-link): New options. + (org-format-agenda-item): Fix bug if TAGS is nil. + (org-agenda-get-scheduled): Quote `priority' symbol in plist. + +2006-04-13 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-set-gud-minor-mode-existing-buffers): + GDB 6.1+ gives full filename for "info sources" so use + file-name-nondirectory. + +2006-04-12 Romain Francoise <romain@orebokech.com> + + * subr.el (read-passwd): Bind `message-log-max' to nil. + 2006-04-12 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/perl-mode.el (perl-indent-new-calculate): @@ -2835,7 +3057,7 @@ (vc-default-update-changelog): Don't use vc-user-login-name, we don't need it here. - * tramp-vc.el (vc-user-login-name): Comment out defadvice, it is + * net/tramp-vc.el (vc-user-login-name): Comment out defadvice, it is no longer necessary. 2006-01-25 Kenichi Handa <handa@m17n.org> diff --git a/lisp/abbrev.el b/lisp/abbrev.el index d7bce2b313a..9ba53f6f6f5 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -160,8 +160,10 @@ or may be omitted (it is usually omitted)." (defun edit-abbrevs-redefine () "Redefine abbrevs according to current buffer contents." (interactive) - (define-abbrevs t) - (set-buffer-modified-p nil)) + (save-restriction + (widen) + (define-abbrevs t) + (set-buffer-modified-p nil))) (defun define-abbrevs (&optional arg) "Define abbrevs according to current visible buffer contents. @@ -195,9 +197,12 @@ the ones defined from the buffer now." Optional argument FILE is the name of the file to read; it defaults to the value of `abbrev-file-name'. Optional second argument QUIETLY non-nil means don't display a message." - (interactive "fRead abbrev file: ") - (load (if (and file (> (length file) 0)) file abbrev-file-name) - nil quietly) + (interactive + (list + (read-file-name (format "Read abbrev file (default %s): " + abbrev-file-name) + nil abbrev-file-name t))) + (load (or file abbrev-file-name) nil quietly) (setq abbrevs-changed nil)) (defun quietly-read-abbrev-file (&optional file) diff --git a/lisp/allout.el b/lisp/allout.el index 31ed3a791ea..66c4b8681db 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -666,6 +666,7 @@ the layout used for the allout.el source file.) `allout-layout' can additionally have the value `t', in which case the value of `allout-default-layout' is used.") (make-variable-buffer-local 'allout-layout) +;;;###autoload (put 'allout-layout 'safe-local-variable t) ;;;_ : Topic header format diff --git a/lisp/apropos.el b/lisp/apropos.el index b490b8173ba..3889655ff99 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -908,6 +908,7 @@ If non-nil TEXT is a string that will be printed as a heading." ;; Calculate key-bindings if we want them. (and do-keys (commandp symbol) + (not (eq symbol 'self-insert-command)) (indent-to 30 1) (if (let ((keys (save-excursion diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index bce30a1de20..36934783b93 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -498,11 +498,11 @@ The time should be in either 24 hour format or am/pm format." (interactive "sTime (hh:mm[am/pm]): \nsMessage: ") (unless (string-match appt-time-regexp new-appt-time) (error "Unacceptable time-string")) - (let* ((appt-time-string (concat new-appt-time " " new-appt-msg)) - (appt-time (list (appt-convert-time new-appt-time))) - (time-msg (list appt-time appt-time-string t))) - (setq appt-time-msg-list (nconc appt-time-msg-list (list time-msg))) - (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) + (let ((time-msg (list (list (appt-convert-time new-appt-time)) + (concat new-appt-time " " new-appt-msg) t))) + (unless (member time-msg appt-time-msg-list) + (setq appt-time-msg-list + (appt-sort-list (nconc appt-time-msg-list (list time-msg))))))) ;;;###autoload (defun appt-delete () diff --git a/lisp/comint.el b/lisp/comint.el index 5ab00354f80..a44e252ca97 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -465,6 +465,7 @@ executed once when the buffer is created." (define-key map "\C-c\C-l" 'comint-dynamic-list-input-ring) (define-key map "\C-c\C-n" 'comint-next-prompt) (define-key map "\C-c\C-p" 'comint-previous-prompt) + (define-key map "\C-c\C-j" 'comint-restore-input) (define-key map "\C-c\C-d" 'comint-send-eof) (define-key map "\C-c\C-s" 'comint-write-output) (define-key map "\C-c." 'comint-insert-previous-argument) @@ -558,6 +559,9 @@ This is to support the command \\[comint-get-next-from-history].") "Non-nil if you are accumulating input lines to send as input together. The command \\[comint-accumulate] sets this.") +(defvar comint-stored-incomplete-input nil + "Stored input for history cycling.") + (put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand) (put 'comint-input-ring 'permanent-local t) (put 'comint-input-ring-index 'permanent-local t) @@ -638,6 +642,7 @@ Entry to this mode runs the hooks on `comint-mode-hook'." (make-local-variable 'comint-scroll-to-bottom-on-input) (make-local-variable 'comint-move-point-for-output) (make-local-variable 'comint-scroll-show-maximum-output) + (make-local-variable 'comint-stored-incomplete-input) ;; This makes it really work to keep point at the bottom. (make-local-variable 'scroll-conservatively) (setq scroll-conservatively 10000) @@ -1015,6 +1020,16 @@ See also `comint-read-input-ring'." (t arg))) +(defun comint-restore-input () + "Restore unfinished input." + (interactive) + (when comint-input-ring-index + (comint-delete-input) + (when (> (length comint-stored-incomplete-input) 0) + (insert comint-stored-incomplete-input) + (message "Input restored")) + (setq comint-input-ring-index nil))) + (defun comint-search-start (arg) "Index to start a directional search, starting at `comint-input-ring-index'." (if comint-input-ring-index @@ -1035,9 +1050,18 @@ Moves relative to `comint-input-ring-index'." arg))) (defun comint-previous-input (arg) - "Cycle backwards through input history." + "Cycle backwards through input history, saving input." (interactive "*p") - (comint-previous-matching-input "." arg)) + (if (and comint-input-ring-index + (or ;; leaving the "end" of the ring + (and (< arg 0) ; going down + (eq comint-input-ring-index 0)) + (and (> arg 0) ; going up + (eq comint-input-ring-index + (1- (ring-length comint-input-ring))))) + comint-stored-incomplete-input) + (comint-restore-input) + (comint-previous-matching-input "." arg))) (defun comint-next-input (arg) "Cycle forwards through input history." @@ -1077,6 +1101,14 @@ Moves relative to START, or `comint-input-ring-index'." (if (string-match regexp (ring-ref comint-input-ring n)) n))) +(defun comint-delete-input () + "Delete all input between accumulation or process mark and point." + (delete-region + ;; Can't use kill-region as it sets this-command + (or (marker-position comint-accum-marker) + (process-mark (get-buffer-process (current-buffer)))) + (point-max))) + (defun comint-previous-matching-input (regexp n) "Search backwards through input history for match for REGEXP. \(Previous history elements are earlier commands.) @@ -1088,13 +1120,13 @@ If N is negative, find the next or Nth next match." ;; Has a match been found? (if (null pos) (error "Not found") + ;; If leaving the edit line, save partial input + (if (null comint-input-ring-index) ;not yet on ring + (setq comint-stored-incomplete-input + (funcall comint-get-old-input))) (setq comint-input-ring-index pos) (message "History item: %d" (1+ pos)) - (delete-region - ;; Can't use kill-region as it sets this-command - (or (marker-position comint-accum-marker) - (process-mark (get-buffer-process (current-buffer)))) - (point)) + (comint-delete-input) (insert (ring-ref comint-input-ring pos))))) (defun comint-next-matching-input (regexp n) diff --git a/lisp/complete.el b/lisp/complete.el index a50d02c41f0..6620db860c3 100644 --- a/lisp/complete.el +++ b/lisp/complete.el @@ -141,8 +141,6 @@ If nil, means use the colon-separated path in the variable $INCPATH instead." "A list of the environment variable names and values.") -(defvar PC-old-read-file-name-internal nil) - (defun PC-bindings (bind) (let ((completion-map minibuffer-local-completion-map) (must-match-map minibuffer-local-must-match-map)) @@ -219,21 +217,32 @@ second TAB brings up the `*Completions*' buffer." ((not PC-disable-includes) (add-hook 'find-file-not-found-functions 'PC-look-for-include-file))) ;; ... with some underhand redefining. - (cond ((and (not partial-completion-mode) - (functionp PC-old-read-file-name-internal)) - (fset 'read-file-name-internal PC-old-read-file-name-internal)) - ((and (not PC-disable-includes) (not PC-old-read-file-name-internal)) - (setq PC-old-read-file-name-internal - (symbol-function 'read-file-name-internal)) - (fset 'read-file-name-internal - 'PC-read-include-file-name-internal))) - (when (and partial-completion-mode (null PC-env-vars-alist)) - (setq PC-env-vars-alist - (mapcar (lambda (string) - (let ((d (string-match "=" string))) - (cons (concat "$" (substring string 0 d)) - (and d (substring string (1+ d)))))) - process-environment)))) + (cond ((not partial-completion-mode) + (ad-disable-advice 'read-file-name-internal 'around 'PC-include-file) + (ad-activate 'read-file-name-internal)) + ((not PC-disable-includes) + (ad-enable-advice 'read-file-name-internal 'around 'PC-include-file) + (ad-activate 'read-file-name-internal))) + ;; Adjust the completion selection in *Completion* buffers to the way + ;; we work. The default minibuffer completion code only completes the + ;; text before point and leaves the text after point alone (new in + ;; Emacs-22). In contrast we use the whole text and we even sometimes + ;; move point to a place before EOB, to indicate the first position where + ;; there's a difference, so when the user uses choose-completion, we have + ;; to trick choose-completion into replacing the whole minibuffer text + ;; rather than only the text before point. --Stef + (funcall + (if partial-completion-mode 'add-hook 'remove-hook) + 'choose-completion-string-functions + (lambda (&rest x) (goto-char (point-max)) nil)) + ;; Build the env-completion and mapping table. + (when (and partial-completion-mode (null PC-env-vars-alist)) + (setq PC-env-vars-alist + (mapcar (lambda (string) + (let ((d (string-match "=" string))) + (cons (concat "$" (substring string 0 d)) + (and d (substring string (1+ d)))))) + process-environment)))) (defun PC-complete () @@ -930,20 +939,23 @@ absolute rather than relative to some directory on the SEARCH-PATH." (setq sorted (cdr sorted))) compressed)))) -(defun PC-read-include-file-name-internal (string dir action) - (if (string-match "<\\([^\"<>]*\\)>?$" string) - (let* ((name (substring string (match-beginning 1) (match-end 1))) +(defadvice read-file-name-internal (around PC-include-file disable) + (if (string-match "<\\([^\"<>]*\\)>?\\'" (ad-get-arg 0)) + (let* ((string (ad-get-arg 0)) + (action (ad-get-arg 2)) + (name (substring string (match-beginning 1) (match-end 1))) (str2 (substring string (match-beginning 0))) (completion-table - (mapcar (function (lambda (x) (list (format "<%s>" x)))) + (mapcar (lambda (x) (format "<%s>" x)) (PC-include-file-all-completions name (PC-include-file-path))))) - (cond - ((not completion-table) nil) - ((eq action nil) (try-completion str2 completion-table nil)) - ((eq action t) (all-completions str2 completion-table nil)) - ((eq action 'lambda) (test-completion str2 completion-table nil)))) - (funcall PC-old-read-file-name-internal string dir action))) + (setq ad-return-value + (cond + ((not completion-table) nil) + ((eq action 'lambda) (test-completion str2 completion-table nil)) + ((eq action nil) (try-completion str2 completion-table nil)) + ((eq action t) (all-completions str2 completion-table nil))))) + ad-do-it)) (provide 'complete) diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index 4de2a431392..e68d2eab293 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -1082,14 +1082,29 @@ Show the buffer in another window, but don't select it." ;; Packages will update this variable, so make it available. ;;;###autoload (defvar customize-package-emacs-version-alist nil - "Alist that maps packages to alists of package to Emacs versions. -The value alists map all package versions used with -the :package-version keyword to Emacs versions. Packages are -symbols and versions are strings. - -For example: - '((MH-E (\"7.4\" \"22.1\") (\"8.0\" \"22.1\")) - (Gnus (\"5.11\" \"22.1\")))") + "Alist mapping versions of Emacs to versions of a package. +These package versions are listed in the :package-version +keyword used in `defcustom', `defgroup', and `defface'. Its +elements look like this: + + (PACKAGE (PVERSION . EVERSION)...) + +For each PACKAGE, which is a symbol, there are one or more +elements that contain a package version PVERSION with an +associated Emacs version EVERSION. These versions are strings. +For example, the MH-E package updates this alist with the +following: + + (add-to-list 'customize-package-emacs-version-alist + '(MH-E (\"6.0\" . \"22.1\") (\"6.1\" . \"22.1\") + (\"7.0\" . \"22.1\") (\"7.1\" . \"22.1\") + (\"7.2\" . \"22.1\") (\"7.3\" . \"22.1\") + (\"7.4\" . \"22.1\") (\"8.0\" . \"22.1\"))) + +The value of PACKAGE needs to be unique and it needs to match the +PACKAGE value appearing in the :package-version keyword. Since +the user might see the value in a error message, a good choice is +the official name of the package, such as MH-E or Gnus.") ;;;###autoload (defalias 'customize-changed 'customize-changed-options) @@ -1154,7 +1169,7 @@ that were added or redefined since that version." (defun customize-package-emacs-version (symbol package-version) "Return Emacs version of SYMBOL. -PACKAGE-VERSION has the form (PACKAGE VERSION). The VERSION of +PACKAGE-VERSION has the form (PACKAGE . VERSION). The VERSION of PACKAGE is looked up in the associated list `customize-package-emacs-version-alist' to find the version of Emacs that is associated with it." @@ -1167,9 +1182,10 @@ Emacs that is associated with it." ((setq package-versions (assq (car package-version) customize-package-emacs-version-alist)) (setq emacs-version - (cadr (assoc (cadr package-version) package-versions))) + (cdr (assoc (cdr package-version) package-versions))) (unless emacs-version - (message "Package version of %s not found in %s" symbol + (message "%s version %s not found in %s" symbol + (cdr package-version) "customize-package-emacs-version-alist"))) (t (message "Package %s neglected to update %s" diff --git a/lisp/custom.el b/lisp/custom.el index cd97b425038..2ac1e23ac49 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -272,11 +272,14 @@ The following common keywords are also meaningful. first introduced, or its default value was changed, in Emacs version VERSION. :package-version - VALUE should be a list with the form (PACKAGE VERSION) + VALUE should be a list with the form (PACKAGE . VERSION) specifying that the variable was first introduced, or its default value was changed, in PACKAGE version VERSION. This keyword takes priority over :version. The PACKAGE and VERSION must appear in the alist `customize-package-emacs-version-alist'. + Since PACKAGE must be unique and the user might see it in an + error message, a good choice is the official name of the + package, such as MH-E or Gnus. :tag LABEL Use LABEL, a string, instead of the item's name, to label the item in customization menus and buffers. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 444c310920d..d0be3a02f65 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -258,6 +258,20 @@ Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol edebug-form-spec )) +;;;###autoload +(defun edebug-basic-spec (spec) + "Return t if SPEC uses only extant spec symbols. +An extant spec symbol is a symbol that is not a function and has a +`edebug-form-spec' property." + (cond ((listp spec) + (catch 'basic + (while spec + (unless (edebug-basic-spec (car spec)) (throw 'basic nil)) + (setq spec (cdr spec))) + t)) + ((symbolp spec) + (unless (functionp spec) (get spec 'edebug-form-spec))))) + ;;; Utilities ;; Define edebug-gensym - from old cl.el diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index 754ad9fdf19..5d504586323 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -228,6 +228,14 @@ The search is done in the source for library LIBRARY." (with-syntax-table emacs-lisp-mode-syntax-table (goto-char (point-min)) (if (or (re-search-forward regexp nil t) + ;; `regexp' matches definitions using known forms like + ;; `defun', or `defvar'. But some functions/variables + ;; are defined using special macros (or functions), so + ;; if `regexp' can't find the definition, we look for + ;; something of the form "(SOMETHING <symbol> ...)". + ;; This fails to distinguish function definitions from + ;; variable declarations (or even uses thereof), but is + ;; a good pragmatic fallback. (re-search-forward (concat "^([^ ]+" find-function-space-re "['(]?" (regexp-quote (symbol-name symbol)) diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el index a4a22806d09..2126d7663fc 100644 --- a/lisp/emacs-lisp/tq.el +++ b/lisp/emacs-lisp/tq.el @@ -27,18 +27,56 @@ ;;; Commentary: -;; manages receiving a stream asynchronously, -;; parsing it into transactions, and then calling -;; handler functions +;; This file manages receiving a stream asynchronously, parsing it +;; into transactions, and then calling the associated handler function +;; upon the completion of each transaction. ;; Our basic structure is the queue/process/buffer triple. Each entry -;; of the queue is a regexp/closure/function triple. We buffer -;; bytes from the process until we see the regexp at the head of the -;; queue. Then we call the function with the closure and the -;; collected bytes. +;; of the queue part is a list of question, regexp, closure, and +;; function that is consed to the last element. + +;; A transaction queue may be created by calling `tq-create'. + +;; A request may be added to the queue by calling `tq-enqueue'. If +;; the `delay-question' argument is non-nil, we will wait to send the +;; question to the process until it has finished sending other input. +;; Otherwise, once a request is enqueued, we send the given question +;; immediately to the process. + +;; We then buffer bytes from the process until we see the regexp that +;; was provided in the call to `tq-enqueue'. Then we call the +;; provided function with the closure and the collected bytes. If we +;; have indicated that the question from the next transaction was not +;; sent immediately, send it at this point, awaiting the response. ;;; Code: +;;; Accessors + +;; This part looks like (queue . (process . buffer)) +(defun tq-queue (tq) (car tq)) +(defun tq-process (tq) (car (cdr tq))) +(defun tq-buffer (tq) (cdr (cdr tq))) + +;; The structure of `queue' is as follows +;; ((question regexp closure . fn) +;; <other queue entries>) +;; question: string to send to the process +(defun tq-queue-head-question (tq) (car (car (tq-queue tq)))) +;; regexp: regular expression that matches the end of a response from +;; the process +(defun tq-queue-head-regexp (tq) (car (cdr (car (tq-queue tq))))) +;; closure: additional data to pass to function +(defun tq-queue-head-closure (tq) (car (cdr (cdr (car (tq-queue tq)))))) +;; fn: function to call upon receiving a complete response from the +;; process +(defun tq-queue-head-fn (tq) (cdr (cdr (cdr (car (tq-queue tq)))))) + +;; Determine whether queue is empty +(defun tq-queue-empty (tq) (not (tq-queue tq))) + +;;; Core functionality + ;;;###autoload (defun tq-create (process) "Create and return a transaction queue communicating with PROCESS. @@ -54,33 +92,37 @@ to a tcp server on another machine." (tq-filter ',tq string))) tq)) -;;; accessors -(defun tq-queue (tq) (car tq)) -(defun tq-process (tq) (car (cdr tq))) -(defun tq-buffer (tq) (cdr (cdr tq))) - -(defun tq-queue-add (tq re closure fn) +(defun tq-queue-add (tq question re closure fn) (setcar tq (nconc (tq-queue tq) - (cons (cons re (cons closure fn)) nil))) + (cons (cons question (cons re (cons closure fn))) nil))) 'ok) -(defun tq-queue-head-regexp (tq) (car (car (tq-queue tq)))) -(defun tq-queue-head-fn (tq) (cdr (cdr (car (tq-queue tq))))) -(defun tq-queue-head-closure (tq) (car (cdr (car (tq-queue tq))))) -(defun tq-queue-empty (tq) (not (tq-queue tq))) -(defun tq-queue-pop (tq) (setcar tq (cdr (car tq))) (null (car tq))) +(defun tq-queue-pop (tq) + (setcar tq (cdr (car tq))) + (let ((question (tq-queue-head-question tq))) + (when question + (process-send-string (tq-process tq) question))) + (null (car tq))) - -;;; must add to queue before sending! -(defun tq-enqueue (tq question regexp closure fn) +(defun tq-enqueue (tq question regexp closure fn &optional delay-question) "Add a transaction to transaction queue TQ. This sends the string QUESTION to the process that TQ communicates with. -When the corresponding answer comes back, we call FN -with two arguments: CLOSURE, and the answer to the question. + +When the corresponding answer comes back, we call FN with two +arguments: CLOSURE, which may contain additional data that FN +needs, and the answer to the question. + REGEXP is a regular expression to match the entire answer; -that's how we tell where the answer ends." - (tq-queue-add tq regexp closure fn) - (process-send-string (tq-process tq) question)) +that's how we tell where the answer ends. + +If DELAY-QUESTION is non-nil, delay sending this question until +the process has finished replying to any previous questions. +This produces more reliable results with some processes." + (let ((sendp (or (not delay-question) + (not (tq-queue-head-question tq))))) + (tq-queue-add tq (unless sendp question) regexp closure fn) + (when sendp + (process-send-string (tq-process tq) question)))) (defun tq-close (tq) "Shut down transaction queue TQ, terminating the process." diff --git a/lisp/env.el b/lisp/env.el index 22a86f13f3d..66d505ee011 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -94,15 +94,10 @@ Use `$$' to insert a single dollar sign." ;; Fixme: Should the environment be recoded if LC_CTYPE &c is set? -(defun setenv (variable &optional value unset substitute-env-vars frame) +(defun setenv (variable &optional value substitute-env-vars frame) "Set the value of the environment variable named VARIABLE to VALUE. VARIABLE should be a string. VALUE is optional; if not provided or nil, the environment variable VARIABLE will be removed. -UNSET if non-nil means to remove VARIABLE from the environment. -SUBSTITUTE-ENV-VARS, if non-nil, means to substitute environment -variables in VALUE with `substitute-env-vars', where see. -Value is the new value if VARIABLE, or nil if removed from the -environment. Interactively, a prefix argument means to unset the variable, and otherwise the current value (if any) of the variable appears at @@ -116,6 +111,13 @@ modifying either `global-environment' or the environment belonging to the selected frame, depending on the value of `local-environment-variables'. +SUBSTITUTE-ENV-VARS, if non-nil, means to substitute environment +variables in VALUE with `substitute-env-vars', which see. +This is normally used only for interactive calls. + +The return value is the new value of VARIABLE, or nil if +it was removed from the environment. + If optional parameter FRAME is non-nil, then it should be a a frame. If the specified frame has its own set of environment variables, this function will modify VARIABLE in it. Note that @@ -127,7 +129,7 @@ As a special case, setting variable `TZ' calls `set-time-zone-rule' as a side-effect." (interactive (if current-prefix-arg - (list (read-envvar-name "Clear environment variable: " 'exact) nil t) + (list (read-envvar-name "Clear environment variable: " 'exact) nil) (let* ((var (read-envvar-name "Set environment variable: " nil)) (value (getenv var))) (when value @@ -137,7 +139,6 @@ a side-effect." (read-from-minibuffer (format "Set %s to value: " var) nil nil nil 'setenv-history value) - nil t)))) (if (and (multibyte-string-p variable) locale-coding-system) (let ((codings (find-coding-systems-string (concat variable value)))) @@ -145,10 +146,9 @@ a side-effect." (memq (coding-system-base locale-coding-system) codings)) (error "Can't encode `%s=%s' with `locale-coding-system'" variable (or value ""))))) - (if unset - (setq value nil) - (if substitute-env-vars - (setq value (substitute-env-vars value)))) + (and value + substitute-env-vars + (setq value (substitute-env-vars value))) (if (multibyte-string-p variable) (setq variable (encode-coding-string variable locale-coding-system))) (if (and value (multibyte-string-p value)) diff --git a/lisp/files.el b/lisp/files.el index 440f2ea4f27..10cdb473045 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -452,6 +452,8 @@ not safe, Emacs queries you, once, whether to set them all. \(When you say yes to certain values, they are remembered as safe.) :safe means set the safe variables, and ignore the rest. +:all means set all variables, whether safe or not. + (Don't set it permanently to :all.) nil means always ignore the file local variables. Any other value means always query you once whether to set them all. @@ -464,8 +466,9 @@ a -*- line. The command \\[normal-mode], when used interactively, always obeys file local variable specifications and the -*- line, and ignores this variable." - :type '(choice (const :tag "Obey" t) + :type '(choice (const :tag "Query Unsafe" t) (const :tag "Safe Only" :safe) + (const :tag "Do all" :all) (const :tag "Ignore" nil) (other :tag "Query" other)) :group 'find-file) @@ -2283,6 +2286,7 @@ asking you for confirmation." default-text-properties display-time-string enable-local-eval + enable-local-variables eval exec-directory exec-path @@ -2319,6 +2323,8 @@ asking you for confirmation." parse-time-rules process-environment rmail-output-file-alist + safe-local-variable-values + safe-local-eval-forms save-some-buffers-action-alist special-display-buffer-names standard-input @@ -2356,9 +2362,11 @@ asking you for confirmation." (c-indent-level . integerp) (comment-column . integerp) (compile-command . string-or-null-p) + (find-file-visit-truename . t) (fill-column . integerp) (fill-prefix . string-or-null-p) (indent-tabs-mode . t) + (kept-old-versions . integerp) (kept-new-versions . integerp) (left-margin . t) (no-byte-compile . t) @@ -2631,6 +2639,7 @@ is specified, returning t if it is specified." (if (or (and (eq enable-local-variables t) (null unsafe-vars) (null risky-vars)) + (eq enable-local-variables :all) (hack-local-variables-confirm result unsafe-vars risky-vars)) (dolist (elt result) @@ -2690,12 +2699,14 @@ It is dangerous if either of these conditions are met: (and (eq (car exp) 'put) (hack-one-local-variable-quotep (nth 1 exp)) (hack-one-local-variable-quotep (nth 2 exp)) - (memq (nth 1 (nth 2 exp)) - '(lisp-indent-hook)) - ;; Only allow safe values of lisp-indent-hook; - ;; not functions. - (or (numberp (nth 3 exp)) - (equal (nth 3 exp) ''defun))) + (let ((prop (nth 1 (nth 2 exp))) (val (nth 3 exp))) + (cond ((eq prop 'lisp-indent-hook) + ;; Only allow safe values of lisp-indent-hook; + ;; not functions. + (or (numberp val) (equal val ''defun))) + ((eq prop 'edebug-form-spec) + ;; Only allow indirect form specs. + (edebug-basic-spec val))))) ;; Allow expressions that the user requested. (member exp safe-local-eval-forms) ;; Certain functions can be allowed with safe arguments diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 792fb2a5c0d..09dbe9e0027 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,52 @@ +2006-04-17 Reiner Steib <Reiner.Steib@gmx.de> + + [ Merge from Gnus trunk. ] + + * mm-util.el (mm-charset-synonym-alist): Improve doc string. + (mm-charset-override-alist): New variable. + (mm-charset-to-coding-system): Use it. + (mm-codepage-setup): New helper function. + (mm-charset-eval-alist): New variable. + (mm-charset-to-coding-system): Use mm-charset-eval-alist. Warn + about unknown charsets. Add allow-override. Use + `mm-charset-override-alist' only when decoding. + (mm-detect-mime-charset-region): Use :mime-charset. + + * mm-bodies.el (mm-decode-body, mm-decode-string): Call + `mm-charset-to-coding-system' with allow-override argument. + + * message.el (message-tool-bar-zap-list, message-tool-bar) + (message-tool-bar-gnome, message-tool-bar-retro): New variables. + (message-tool-bar-local-item-from-menu): Remove. + (message-tool-bar-map): Replace by `message-make-tool-bar'. + (message-make-tool-bar): New function. + (message-mode): Use `message-make-tool-bar'. + + * gnus-sum.el (gnus-summary-tool-bar) + (gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro) + (gnus-summary-tool-bar-zap-list): New variables. + (gnus-summary-make-tool-bar): Complete rewrite using + `gmm-tool-bar-from-list'. + + * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome) + (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list): New + variables. + (gnus-group-make-tool-bar): Complete rewrite using + `gmm-tool-bar-from-list'. + (gnus-group-tool-bar-update): New function. + + * gmm-utils.el: New file. + +2006-04-12 Ralf Angeli <angeli@iwi.uni-sb.de> + + * flow-fill.el (fill-flowed): Remove trailing space from blank + quoted lines. + +2006-04-12 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-art.el (gnus-article-mode): Set + cursor-in-non-selected-windows to nil. + 2006-04-12 Katsumi Yamaoka <yamaoka@jpl.org> * gnus-art.el (gnus-mime-view-part-as-charset): Ignore charset @@ -12,13 +61,6 @@ * gnus-uu.el (gnus-uu-save-article): Put mml tags instead of part tag to summarized topics part in order to encode non-ASCII text. -2006-04-12 Kenichi Handa <handa@m17n.org> - - * rfc2231.el (rfc2231-decode-encoded-string): Work on unibyte - buffer and then decode the buffer text if necessary. - (rfc2231-encode-string): Be sure to work on multibyte buffer at - first, and after mm-encode-body, change the buffer to unibyte. - 2006-04-11 Reiner Steib <Reiner.Steib@gmx.de> * gnus-art.el (gnus-button-valid-localpart-regexp): Exclude `@'. diff --git a/lisp/gnus/flow-fill.el b/lisp/gnus/flow-fill.el index 98697439106..b47e9ba8365 100644 --- a/lisp/gnus/flow-fill.el +++ b/lisp/gnus/flow-fill.el @@ -114,7 +114,7 @@ RFC 2646 suggests 66 characters for readability." (set-buffer (or (current-buffer) buffer)) (goto-char (point-min)) ;; Remove space stuffing. - (while (re-search-forward "^ " nil t) + (while (re-search-forward "^\\( \\|>+ $\\)" nil t) (delete-char -1) (forward-line 1)) (goto-char (point-min)) diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el new file mode 100644 index 00000000000..4db811053ec --- /dev/null +++ b/lisp/gnus/gmm-utils.el @@ -0,0 +1,413 @@ +;;; gmm-utils.el --- Utility functions for Gnus, Message and MML + +;; Copyright (C) 2006 Free Software Foundation, Inc. + +;; Author: Reiner Steib <reiner.steib@gmx.de> +;; Keywords: news + +;; 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: + +;; This library provides self-contained utility functions. The functions are +;; used in Gnus, Message and MML, but within this library there are no +;; dependencies on Gnus, Message, or MML or Gnus. + +;;; Code: + +;; (require 'wid-edit) + +(defgroup gmm nil + "Utility functions for Gnus, Message and MML" + :prefix "gmm-" + :version "23.0" ;; No Gnus + :group 'lisp) + +;; Helper functions from `gnus-utils.el': gmm-verbose, gmm-message, gmm-error + +(defcustom gmm-verbose 7 + "Integer that says how verbose gmm should be. +The higher the number, the more messages will flash to say what +it done. At zero, it will be totally mute; at five, it will +display most important messages; and at ten, it will keep on +jabbering all the time." + :type 'integer + :group 'gmm) + +;;;###autoload +(defun gmm-message (level &rest args) + "If LEVEL is lower than `gmm-verbose' print ARGS using `message'. + +Guideline for numbers: +1 - error messages, 3 - non-serious error messages, 5 - messages for things +that take a long time, 7 - not very important messages on stuff, 9 - messages +inside loops." + (if (<= level gmm-verbose) + (apply 'message args) + ;; We have to do this format thingy here even if the result isn't + ;; shown - the return value has to be the same as the return value + ;; from `message'. + (apply 'format args))) + +;;;###autoload +(defun gmm-error (level &rest args) + "Beep an error if LEVEL is equal to or less than `gmm-verbose'. +ARGS are passed to `message'." + (when (<= (floor level) gmm-verbose) + (apply 'message args) + (ding) + (let (duration) + (when (and (floatp level) + (not (zerop (setq duration (* 10 (- level (floor level))))))) + (sit-for duration)))) + nil) + +;;;###autoload +(defun gmm-widget-p (symbol) + "Non-nil iff SYMBOL is a widget." + (get symbol 'widget-type)) + +;; Copy of the `nnmail-lazy' code from `nnmail.el': +(define-widget 'gmm-lazy 'default + "Base widget for recursive datastructures. + +This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility." + :format "%{%t%}: %v" + :convert-widget 'widget-value-convert-widget + :value-create (lambda (widget) + (let ((value (widget-get widget :value)) + (type (widget-get widget :type))) + (widget-put widget :children + (list (widget-create-child-value + widget (widget-convert type) value))))) + :value-delete 'widget-children-value-delete + :value-get (lambda (widget) + (widget-value (car (widget-get widget :children)))) + :value-inline (lambda (widget) + (widget-apply (car (widget-get widget :children)) + :value-inline)) + :default-get (lambda (widget) + (widget-default-get + (widget-convert (widget-get widget :type)))) + :match (lambda (widget value) + (widget-apply (widget-convert (widget-get widget :type)) + :match value)) + :validate (lambda (widget) + (widget-apply (car (widget-get widget :children)) :validate))) + +;; Note: The format of `gmm-tool-bar-item' may change if some future Emacs +;; version will provide customizable tool bar buttons using a different +;; interface. + +;; TODO: Extend API so that the "Command" entry can be a function or a plist. +;; In case of a list it should have the format... +;; +;; (:none command-without-modifier +;; :shift command-with-shift-pressed +;; :control command-with-ctrl-pressed +;; :control-shift command-with-control-and-shift-pressed +;; ;; mouse-2 and mouse-3 can't be used in Emacs yet. +;; :mouse-2 command-on-mouse-2-press +;; :mouse-3 command-on-mouse-3-press) ;; typically a menu of related commands +;; +;; Combinations of mouse-[23] plus shift and/or controll might be overkill. +;; +;; Then use (plist-get rs-command :none), (plist-get rs-command :shift) + +(define-widget 'gmm-tool-bar-item (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy) + "Tool bar list item." + :tag "Tool bar item" + :type '(choice + (list :tag "Command and Icon" + (function :tag "Command") + (string :tag "Icon file") + (choice + (const :tag "Default map" nil) + ;; Note: Usually we need non-nil attributes if map is t. + (const :tag "No menu" t) + (sexp :tag "Other map")) + (plist :inline t :tag "Properties")) + (list :tag "Separator" + (const :tag "No command" gmm-ignore) + (string :tag "Icon file") + (const :tag "No map") + (plist :inline t :tag "Properties")))) + +(define-widget 'gmm-tool-bar-zap-list (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy) + "Tool bar zap list." + :tag "Tool bar zap list" + :type '(choice (const :tag "Zap all" t) + (const :tag "Keep all" nil) + (list + ;; :value + ;; Work around (bug in customize?), see + ;; <news:v9is48jrj1.fsf@marauder.physik.uni-ulm.de> + ;; (new-file open-file dired kill-buffer write-file + ;; print-buffer customize help) + (set :inline t + (const new-file) + (const open-file) + (const dired) + (const kill-buffer) + (const save-buffer) + (const write-file) + (const undo) + (const cut) + (const copy) + (const paste) + (const search-forward) + (const print-buffer) + (const customize) + (const help)) + (repeat :inline t + :tag "Other" + (symbol :tag "Icon item"))))) + +;; (defun gmm-color-cells (&optional display) +;; "Return the number of color cells supported by DISPLAY. +;; Compatibility function." +;; ;; `display-color-cells' doesn't return more than 256 even if color depth is +;; ;; > 8 in Emacs 21. +;; ;; +;; ;; Feel free to add proper XEmacs support. +;; (let* ((cells (and (fboundp 'display-color-cells) +;; (display-color-cells display))) +;; (plane (and (fboundp 'x-display-planes) +;; (ash 1 (x-display-planes)))) +;; (none -1)) +;; (max (if (integerp cells) cells none) +;; (if (integerp plane) plane none)))) + +(defcustom gmm-tool-bar-style + (if (and (boundp 'tool-bar-mode) + tool-bar-mode + (and (fboundp 'display-visual-class) + (not (memq (display-visual-class) + (list 'static-gray 'gray-scale + 'static-color 'pseudo-color))))) + 'gnome + 'retro) + "Prefered tool bar style." + :type '(choice (const :tag "GNOME style" 'gnome) + (const :tag "Retro look" 'retro)) + :group 'gmm) + +(defvar tool-bar-map) + +;;;###autoload +(defun gmm-tool-bar-from-list (icon-list zap-list default-map) + "Make a tool bar from ICON-LIST. + +Within each entry of ICON-LIST, the first element is a menu +command, the second element is an icon file name and the third +element is a test function. You can use \\[describe-key] +<menu-entry> to find out the name of a menu command. The fourth +and all following elements are passed a the PROPS argument to the +function `tool-bar-local-item'. + +If ZAP-LIST is a list, remove those item from the default +`tool-bar-map'. If it is t, start with a new sparse map. You +can use \\[describe-key] <icon> to find out the name of an icon +item. When \\[describe-key] <icon> shows \"<tool-bar> <new-file> +runs the command find-file\", then use `new-file' in ZAP-LIST. + +DEFAULT-MAP specifies the default key map for ICON-LIST." + (let (;; For Emacs 21, we must let-bind `tool-bar-map'. In Emacs 22, we + ;; could use some other local variable. + (tool-bar-map (if (eq zap-list t) + (make-sparse-keymap) + (copy-keymap tool-bar-map)))) + (when (listp zap-list) + ;; Zap some items which aren't relevant for this mode and take up space. + (dolist (key zap-list) + (define-key tool-bar-map (vector key) nil))) + (mapc (lambda (el) + (let ((command (car el)) + (icon (nth 1 el)) + (fmap (or (nth 2 el) default-map)) + (props (cdr (cdr (cdr el)))) ) + ;; command may stem from different from-maps: + (cond ((eq command 'gmm-ignore) + ;; The dummy `gmm-ignore', see `gmm-tool-bar-item' + ;; widget. Suppress tooltip by adding `:enable nil'. + (if (fboundp 'tool-bar-local-item) + (apply 'tool-bar-local-item icon nil nil + tool-bar-map :enable nil props) + ;; (tool-bar-local-item ICON DEF KEY MAP &rest PROPS) + ;; (tool-bar-add-item ICON DEF KEY &rest PROPS) + (apply 'tool-bar-add-item icon nil nil :enable nil props))) + ((equal fmap t) ;; Not a menu command + (if (fboundp 'tool-bar-local-item) + (apply 'tool-bar-local-item + icon command + (intern icon) ;; reuse icon or fmap here? + tool-bar-map props) + ;; Emacs 21 compatibility: + (apply 'tool-bar-add-item + icon command + (intern icon) + props))) + (t ;; A menu command + (if (fboundp 'tool-bar-local-item-from-menu) + (apply 'tool-bar-local-item-from-menu + ;; (apply 'tool-bar-local-item icon def key + ;; tool-bar-map props) + command icon tool-bar-map (symbol-value fmap) + props) + ;; Emacs 21 compatibility: + (apply 'tool-bar-add-item-from-menu + command icon (symbol-value fmap) + props)))) + t)) + (if (symbolp icon-list) + (eval icon-list) + icon-list)) + tool-bar-map)) + +;; WARNING: The following is subject to change. Don't rely on it yet. + +;; From MH-E without modifications: + +(defmacro gmm-defun-compat (name function arg-list &rest body) + "Create function NAME. +If FUNCTION exists, then NAME becomes an alias for FUNCTION. +Otherwise, create function NAME with ARG-LIST and BODY." + (let ((defined-p (fboundp function))) + (if defined-p + `(defalias ',name ',function) + `(defun ,name ,arg-list ,@body)))) + +(gmm-defun-compat gmm-image-search-load-path + image-search-load-path (file &optional path) + "Emacs 21 and XEmacs don't have `image-search-load-path'. +This function returns nil on those systems." + nil) + +;; From MH-E with modifications: + +;; Don't use `gmm-defun-compat' until API changes in +;; `image-load-path-for-library' in Emacs CVS are completed. + +(defun gmm-image-load-path-for-library (library image &optional path no-error) + "Return a suitable search path for images relative to LIBRARY. + +First it searches for IMAGE in `image-load-path' (excluding +\"`data-directory'/images\") and `load-path', followed by a path +suitable for LIBRARY, which includes \"../../etc/images\" and +\"../etc/images\" relative to the library file itself, and then +in \"`data-directory'/images\". + +Then this function returns a list of directories which contains +first the directory in which IMAGE was found, followed by the +value of `load-path'. If PATH is given, it is used instead of +`load-path'. + +If NO-ERROR is non-nil and a suitable path can't be found, don't +signal an error. Instead, return a list of directories as before, +except that nil appears in place of the image directory. + +Here is an example that uses a common idiom to provide +compatibility with versions of Emacs that lack the variable +`image-load-path': + + ;; Shush compiler. + (defvar image-load-path) + + (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\")) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path)))) + (mh-tool-bar-folder-buttons-init))" + (unless library (error "No library specified")) + (unless image (error "No image specified")) + (let (image-directory image-directory-load-path) + ;; Check for images in image-load-path or load-path. + (let ((img image) + (dir (or + ;; Images in image-load-path. + (gmm-image-search-load-path image) ;; "gmm-" prefix! + ;; Images in load-path. + (locate-library image))) + parent) + ;; Since the image might be in a nested directory (for + ;; example, mail/attach.pbm), adjust `image-directory' + ;; accordingly. + (when dir + (setq dir (file-name-directory dir)) + (while (setq parent (file-name-directory img)) + (setq img (directory-file-name parent) + dir (expand-file-name "../" dir)))) + (setq image-directory-load-path dir)) + + ;; If `image-directory-load-path' isn't Emacs' image directory, + ;; it's probably a user preference, so use it. Then use a + ;; relative setting if possible; otherwise, use + ;; `image-directory-load-path'. + (cond + ;; User-modified image-load-path? + ((and image-directory-load-path + (not (equal image-directory-load-path + (file-name-as-directory + (expand-file-name "images" data-directory))))) + (setq image-directory image-directory-load-path)) + ;; Try relative setting. + ((let (library-name d1ei d2ei) + ;; First, find library in the load-path. + (setq library-name (locate-library library)) + (if (not library-name) + (error "Cannot find library %s in load-path" library)) + ;; And then set image-directory relative to that. + (setq + ;; Go down 2 levels. + d2ei (file-name-as-directory + (expand-file-name + (concat (file-name-directory library-name) "../../etc/images"))) + ;; Go down 1 level. + d1ei (file-name-as-directory + (expand-file-name + (concat (file-name-directory library-name) "../etc/images")))) + (setq image-directory + ;; Set it to nil if image is not found. + (cond ((file-exists-p (expand-file-name image d2ei)) d2ei) + ((file-exists-p (expand-file-name image d1ei)) d1ei))))) + ;; Use Emacs' image directory. + (image-directory-load-path + (setq image-directory image-directory-load-path)) + (no-error + (message "Could not find image %s for library %s" image library)) + (t + (error "Could not find image %s for library %s" image library))) + + ;; Return an augmented `path' or `load-path'. + (nconc (list image-directory) + (delete image-directory (copy-sequence (or path load-path)))))) + +(defun gmm-customize-mode (&optional mode) + "Customize customization group for MODE. +If mode is nil, use `major-mode' of the curent buffer." + (interactive) + (customize-group + (or mode + (intern (let ((mode (symbol-name major-mode))) + (string-match "^\\(.+\\)-mode$" mode) + (match-string 1 mode)))))) + +(provide 'gmm-utils) + +;; arch-tag: e0b60920-2ce6-40c1-bfc0-cadbbe26b602 +;;; gmm-utils.el ends here diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index a4da4ae85f3..7e3b843d500 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -3809,6 +3809,7 @@ commands: (make-local-variable 'gnus-article-ignored-charsets) ;; Prevent recent Emacsen from displaying non-break space as "\ ". (set (make-local-variable 'nobreak-char-display) nil) + (setq cursor-in-non-selected-windows nil) (gnus-set-default-directory) (buffer-disable-undo) (setq buffer-read-only t) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 24e4df14712..51af7d48d9c 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -39,6 +39,7 @@ (require 'gnus-range) (require 'gnus-win) (require 'gnus-undo) +(require 'gmm-utils) (require 'time-date) (require 'gnus-ems) @@ -979,36 +980,135 @@ simple manner.") (gnus-run-hooks 'gnus-group-menu-hook))) -(defvar gnus-group-toolbar-map nil) - -;; Emacs 21 tool bar. Should be no-op otherwise. -(defun gnus-group-make-tool-bar () - (if (and - (condition-case nil (require 'tool-bar) (error nil)) - (fboundp 'tool-bar-add-item-from-menu) - (default-value 'tool-bar-mode) - (not gnus-group-toolbar-map)) - (setq gnus-group-toolbar-map - (let ((tool-bar-map (make-sparse-keymap)) - (load-path (mm-image-load-path))) - (tool-bar-add-item-from-menu - 'gnus-group-get-new-news "get-news" gnus-group-mode-map) - (tool-bar-add-item-from-menu - 'gnus-group-get-new-news-this-group "gnntg" gnus-group-mode-map) - (tool-bar-add-item-from-menu - 'gnus-group-catchup-current "catchup" gnus-group-mode-map) - (tool-bar-add-item-from-menu - 'gnus-group-describe-group "describe-group" gnus-group-mode-map) - (tool-bar-add-item "subscribe" 'gnus-group-subscribe 'subscribe - :help "Subscribe to the current group") - (tool-bar-add-item "unsubscribe" 'gnus-group-unsubscribe - 'unsubscribe - :help "Unsubscribe from the current group") - (tool-bar-add-item-from-menu - 'gnus-group-exit "exit-gnus" gnus-group-mode-map) - tool-bar-map))) - (if gnus-group-toolbar-map - (set (make-local-variable 'tool-bar-map) gnus-group-toolbar-map))) + +(defvar gnus-group-tool-bar-map nil) + +(defun gnus-group-tool-bar-update (&optional symbol value) + "Update group buffer toolbar. +Setter function for custom variables." + (when symbol + (set-default symbol value)) + ;; (setq-default gnus-group-tool-bar-map nil) + ;; (use-local-map gnus-group-mode-map) + (when (gnus-alive-p) + (with-current-buffer gnus-group-buffer + (gnus-group-make-tool-bar t)))) + +(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome) + 'gnus-group-tool-bar-gnome + 'gnus-group-tool-bar-retro) + "Specifies the Gnus group tool bar. + +It can be either a list or a symbol refering to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `gnus-group-mode-map'. + +Pre-defined symbols include `gnus-group-tool-bar-gnome' and +`gnus-group-tool-bar-retro'." + :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome) + (const :tag "Retro look" gnus-group-tool-bar-retro) + (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-group-tool-bar-update + :group 'gnus-group) + +(defcustom gnus-group-tool-bar-gnome + '((gnus-group-post-news "mail/compose") + ;; Some useful agent icons? I don't use the agent so agent users should + ;; suggest useful commands: + (gnus-agent-toggle-plugged "connect" t + :visible (and gnus-agent (not gnus-plugged))) + (gnus-agent-toggle-plugged "disconnect" t + :visible (and gnus-agent gnus-plugged)) + ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar) + ;; should have a better help text. + (gnus-group-send-queue "mail/outbox" t + :visible (and gnus-agent gnus-plugged) + :help "Send articles from the queue group") + (gnus-group-get-new-news "mail/inbox" nil + :visible (or (not gnus-agent) + gnus-plugged)) + ;; FIXME: gnus-*-read-group should have a better help text. + (gnus-topic-read-group "open" nil + :visible (and (boundp 'gnus-topic-mode) + gnus-topic-mode)) + (gnus-group-read-group "open" nil + :visible (not (and (boundp 'gnus-topic-mode) + gnus-topic-mode))) + ;; (gnus-group-find-new-groups "???" nil) + (gnus-group-save-newsrc "save") + (gnus-group-describe-group "describe") + (gnus-group-unsubscribe-current-group "gnus/toggle-subscription") + (gnus-group-prev-unread-group "left-arrow") + (gnus-group-next-unread-group "right-arrow") + (gnus-group-exit "exit") + (gmm-customize-mode "preferences" t :help "Edit mode preferences") + (gnus-info-find-node "help")) + "List of functions for the group tool bar (GNOME style). + +See `gmm-tool-bar-from-list' for the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-group-tool-bar-update + :group 'gnus-group) + +(defcustom gnus-group-tool-bar-retro + '((gnus-group-get-new-news "gnus/get-news") + (gnus-group-get-new-news-this-group "gnus/gnntg") + (gnus-group-catchup-current "gnus/catchup") + (gnus-group-describe-group "gnus/describe-group") + (gnus-group-subscribe "gnus/subscribe" t + :help "Subscribe to the current group") + (gnus-group-unsubscribe "gnus/unsubscribe" t + :help "Unsubscribe from the current group") + (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map)) + "List of functions for the group tool bar (retro look). + +See `gmm-tool-bar-from-list' for the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-group-tool-bar-update + :group 'gnus-group) + +(defcustom gnus-group-tool-bar-zap-list t + "List of icon items from the global tool bar. +These items are not displayed in the Gnus group mode tool bar. + +See `gmm-tool-bar-from-list' for the format of the list." + :type 'gmm-tool-bar-zap-list + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-group-tool-bar-update + :group 'gnus-group) + +(defvar image-load-path) + +(defun gnus-group-make-tool-bar (&optional force) + "Make a group mode tool bar from `gnus-group-tool-bar'. +When FORCE, rebuild the tool bar." + (when (and (not (featurep 'xemacs)) + (boundp 'tool-bar-mode) + tool-bar-mode + ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode). + ;; Why? --rsteib + (or (not gnus-group-tool-bar-map) force)) + (let* ((load-path + (gmm-image-load-path-for-library "gnus" + "gnus/toggle-subscription.xpm" + nil t)) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path))) + (map (gmm-tool-bar-from-list gnus-group-tool-bar + gnus-group-tool-bar-zap-list + 'gnus-group-mode-map))) + (if map + (set (make-local-variable 'tool-bar-map) map)))) + gnus-group-tool-bar-map) (defun gnus-group-mode () "Major mode for reading news. @@ -1379,6 +1479,17 @@ if it is a string, only list groups matching REGEXP." (gnus-range-difference (list active) (gnus-info-read info)) seen)))))) +;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't +;; update the state (enabled/disabled) of the icon `gnus-group-describe-group' +;; automatically. After `C-l' the state is correct. See the following report +;; on emacs-devel +;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>: +;; From: Reiner Steib +;; Subject: tool bar icons not updated according to :active condition +;; Newsgroups: gmane.emacs.devel +;; Date: Mon, 23 Jan 2006 19:59:13 +0100 +;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de> + (defcustom gnus-group-update-tool-bar (and (not (featurep 'xemacs)) (boundp 'tool-bar-mode) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index bea7cb2445e..0de73bc879a 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -38,6 +38,7 @@ (require 'gnus-int) (require 'gnus-undo) (require 'gnus-util) +(require 'gmm-utils) (require 'mm-decode) (require 'nnoo) @@ -2546,47 +2547,161 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (defvar gnus-summary-tool-bar-map nil) -;; Emacs 21 tool bar. Should be no-op otherwise. -(defun gnus-summary-make-tool-bar () - (if (and (fboundp 'tool-bar-add-item-from-menu) - (default-value 'tool-bar-mode) - (not gnus-summary-tool-bar-map)) - (setq gnus-summary-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap)) - (load-path (mm-image-load-path))) - (tool-bar-add-item-from-menu - 'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-next-unread "next-ur" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-post-news "post" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-followup-with-original "fuwo" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-followup "followup" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-reply-with-original "reply-wo" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-reply "reply" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-caesar-message "rot13" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-uu-decode-uu "uu-decode" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-save-article-file "save-aif" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-save-article "save-art" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-uu-post-news "uu-post" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-catchup "catchup" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-catchup-and-exit "cu-exit" gnus-summary-mode-map) - (tool-bar-add-item-from-menu - 'gnus-summary-exit "exit-summ" gnus-summary-mode-map) - tool-bar-map))) - (if gnus-summary-tool-bar-map - (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) +;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only +;; affect _new_ message buffers. We might add a function that walks thru all +;; summary-mode buffers and force the update. +(defun gnus-summary-tool-bar-update (&optional symbol value) + "Update summary mode toolbar. +Setter function for custom variables." + (setq-default gnus-summary-tool-bar-map nil) + (when symbol + ;; When used as ":set" function: + (set-default symbol value)) + (when (gnus-buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + (gnus-summary-make-tool-bar)))) + +(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome) + 'gnus-summary-tool-bar-gnome + 'gnus-summary-tool-bar-retro) + "Specifies the Gnus summary tool bar. + +It can be either a list or a symbol refering to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `gnus-summary-mode-map'. + +Pre-defined symbols include `gnus-summary-tool-bar-gnome' and +`gnus-summary-tool-bar-retro'." + :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome) + (const :tag "Retro look" gnus-summary-tool-bar-retro) + (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-summary-tool-bar-update + :group 'gnus-summary) + +(defcustom gnus-summary-tool-bar-gnome + '((gnus-summary-post-news "mail/compose" nil) + (gnus-summary-insert-new-articles "mail/inbox" nil + :visible (or (not gnus-agent) + gnus-plugged)) + (gnus-summary-reply-with-original "mail/reply") + (gnus-summary-reply "mail/reply" nil :visible nil) + (gnus-summary-followup-with-original "mail/reply-all") + (gnus-summary-followup "mail/reply-all" nil :visible nil) + (gnus-summary-mail-forward "mail/forward") + (gnus-summary-save-article "mail/save") + (gnus-summary-search-article-forward "search" nil :visible nil) + (gnus-summary-print-article "print") + (gnus-summary-tick-article-forward "flag-followup" nil :visible nil) + ;; Some new commands that may need more suitable icons: + (gnus-summary-save-newsrc "save" nil :visible nil) + ;; (gnus-summary-show-article "stock_message-display" nil :visible nil) + (gnus-summary-prev-article "left-arrow") + (gnus-summary-next-article "right-arrow") + (gnus-summary-next-page "next-page") + ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil) + ;; + ;; Maybe some sort-by-... could be added: + ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil) + ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil) + (gnus-summary-mark-as-expirable + "delete" nil + :visible (gnus-check-backend-function 'request-expire-articles + gnus-newsgroup-name)) + (gnus-summary-mark-as-spam + "mail/spam" t + :visible (and (fboundp 'spam-group-ham-contents-p) + (spam-group-ham-contents-p gnus-newsgroup-name)) + :help "Mark as spam") + (gnus-summary-mark-as-read-forward + "mail/not-spam" nil + :visible (and (fboundp 'spam-group-spam-contents-p) + (spam-group-spam-contents-p gnus-newsgroup-name))) + ;; + (gnus-summary-exit "exit") + (gmm-customize-mode "preferences" t :help "Edit mode preferences") + (gnus-info-find-node "help")) + "List of functions for the summary tool bar (GNOME style). + +See `gmm-tool-bar-from-list' for the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-summary-tool-bar-update + :group 'gnus-summary) + +(defcustom gnus-summary-tool-bar-retro + '((gnus-summary-prev-unread-article "gnus/prev-ur") + (gnus-summary-next-unread-article "gnus/next-ur") + (gnus-summary-post-news "gnus/post") + (gnus-summary-followup-with-original "gnus/fuwo") + (gnus-summary-followup "gnus/followup") + (gnus-summary-reply-with-original "gnus/reply-wo") + (gnus-summary-reply "gnus/reply") + (gnus-summary-caesar-message "gnus/rot13") + (gnus-uu-decode-uu "gnus/uu-decode") + (gnus-summary-save-article-file "gnus/save-aif") + (gnus-summary-save-article "gnus/save-art") + (gnus-uu-post-news "gnus/uu-post") + (gnus-summary-catchup "gnus/catchup") + (gnus-summary-catchup-and-exit "gnus/cu-exit") + (gnus-summary-exit "gnus/exit-summ") + ;; Some new command that may need more suitable icons: + (gnus-summary-print-article "gnus/print" nil :visible nil) + (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil) + (gnus-summary-save-newsrc "gnus/save" nil :visible nil) + ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil) + (gnus-summary-search-article-forward "gnus/search" nil :visible nil) + ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil) + ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil) + ;; + (gnus-info-find-node "gnus/help" nil :visible nil)) + "List of functions for the summary tool bar (retro look). + +See `gmm-tool-bar-from-list' for the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-summary-tool-bar-update + :group 'gnus-summary) + +(defcustom gnus-summary-tool-bar-zap-list t + "List of icon items from the global tool bar. +These items are not displayed in the Gnus summary mode tool bar. + +See `gmm-tool-bar-from-list' for the format of the list." + :type 'gmm-tool-bar-zap-list + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'gnus-summary-tool-bar-update + :group 'gnus-summary) + +(defvar image-load-path) + +(defun gnus-summary-make-tool-bar (&optional force) + "Make a summary mode tool bar from `gnus-summary-tool-bar'. +When FORCE, rebuild the tool bar." + (when (and (not (featurep 'xemacs)) + (boundp 'tool-bar-mode) + tool-bar-mode + (or (not gnus-summary-tool-bar-map) force)) + (let* ((load-path + (gmm-image-load-path-for-library "gnus" + "mail/save.xpm" + nil t)) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path))) + (map (gmm-tool-bar-from-list gnus-summary-tool-bar + gnus-summary-tool-bar-zap-list + 'gnus-summary-mode-map))) + (when map + ;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode' + ;; uses it's value. + (setq gnus-summary-tool-bar-map map)))) + (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)) (defun gnus-score-set-default (var value) "A version of set that updates the GNU Emacs menu-bar." diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 741b193f779..472eb2468dd 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -37,6 +37,7 @@ (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary (require 'canlock) (require 'mailheader) +(require 'gmm-utils) (require 'nnheader) ;; This is apparently necessary even though things are autoloaded. ;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better @@ -2529,7 +2530,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (set (make-local-variable 'font-lock-defaults) '(message-font-lock-keywords t)) (if (boundp 'tool-bar-map) - (set (make-local-variable 'tool-bar-map) (message-tool-bar-map)))) + (set (make-local-variable 'tool-bar-map) (message-make-tool-bar)))) (easy-menu-add message-mode-menu message-mode-map) (easy-menu-add message-mode-field-menu message-mode-map) (gnus-make-local-hook 'after-change-functions) @@ -6586,53 +6587,123 @@ which specify the range to operate on." ;; Support for toolbar (eval-when-compile - (defvar tool-bar-map) (defvar tool-bar-mode)) -(defun message-tool-bar-local-item-from-menu (command icon in-map &optional from-map &rest props) - ;; We need to make tool bar entries in local keymaps with - ;; `tool-bar-local-item-from-menu' in Emacs >= 22 - (if (fboundp 'tool-bar-local-item-from-menu) - (tool-bar-local-item-from-menu command icon in-map from-map props) - (tool-bar-add-item-from-menu command icon from-map props))) - -(defun message-tool-bar-map () - (or message-tool-bar-map - (setq message-tool-bar-map - (and - (condition-case nil (require 'tool-bar) (error nil)) - (fboundp 'tool-bar-add-item-from-menu) +;; Note: The :set function in the `message-tool-bar*' variables will only +;; affect _new_ message buffers. We might add a function that walks thru all +;; message-mode buffers and force the update. +(defun message-tool-bar-update (&optional symbol value) + "Update message mode toolbar. +Setter function for custom variables." + (setq-default message-tool-bar-map nil) + (when symbol + ;; When used as ":set" function: + (set-default symbol value))) + +(defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome) + 'message-tool-bar-gnome + 'message-tool-bar-retro) + "Specifies the message mode tool bar. + +It can be either a list or a symbol refering to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `message-mode-map'. + +Pre-defined symbols include `message-tool-bar-gnome' and +`message-tool-bar-retro'." + :type '(repeat gmm-tool-bar-list-item) + :type '(choice (const :tag "GNOME style" message-tool-bar-gnome) + (const :tag "Retro look" message-tool-bar-retro) + (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'message-tool-bar-update + :group 'message) + +(defcustom message-tool-bar-gnome + '((ispell-message "spell" nil + :visible (or (not (boundp 'flyspell-mode)) + (not flyspell-mode))) + (flyspell-buffer "spell" t + :visible (and (boundp 'flyspell-mode) + flyspell-mode) + :help "Flyspell whole buffer") + (gmm-ignore "separator") + (message-send-and-exit "mail/send") + (message-dont-send "mail/save-draft") + (message-kill-buffer "close") ;; stock_cancel + (mml-attach-file "attach" mml-mode-map) + (mml-preview "mail/preview" mml-mode-map) + ;; (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil) + (message-insert-importance-high "important" nil :visible nil) + (message-insert-importance-low "unimportant" nil :visible nil) + (message-insert-disposition-notification-to "receipt" nil :visible nil) + (gmm-customize-mode "preferences" t :help "Edit mode preferences") + (message-info "help" t :help "Message manual")) + "List of items for the message tool bar (GNOME style). + +See `gmm-tool-bar-from-list' for details on the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'message-tool-bar-update + :group 'message) + +(defcustom message-tool-bar-retro + '(;; Old Emacs 21 icon for consistency. + (message-send-and-exit "gnus/mail_send") + (message-kill-buffer "close") + (message-dont-send "cancel") + (mml-attach-file "attach" mml-mode-map) + (ispell-message "spell") + (mml-preview "preview" mml-mode-map) + (message-insert-importance-high "gnus/important") + (message-insert-importance-low "gnus/unimportant") + (message-insert-disposition-notification-to "gnus/receipt")) + "List of items for the message tool bar (retro style). + +See `gmm-tool-bar-from-list' for details on the format of the list." + :type '(repeat gmm-tool-bar-item) + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'message-tool-bar-update + :group 'message) + +(defcustom message-tool-bar-zap-list + '(new-file open-file dired kill-buffer write-file + print-buffer customize help) + "List of icon items from the global tool bar. +These items are not displayed on the message mode tool bar. + +See `gmm-tool-bar-from-list' for the format of the list." + :type 'gmm-tool-bar-zap-list + :version "22.1" ;; Gnus 5.10.9 + :initialize 'custom-initialize-default + :set 'message-tool-bar-update + :group 'message) + +(defvar image-load-path) + +(defun message-make-tool-bar (&optional force) + "Make a message mode tool bar from `message-tool-bar-list'. +When FORCE, rebuild the tool bar." + (when (and (not (featurep 'xemacs)) + (boundp 'tool-bar-mode) tool-bar-mode - (let ((tool-bar-map (copy-keymap tool-bar-map)) - (load-path (mm-image-load-path))) - ;; Zap some items which aren't so relevant and take - ;; up space. - (dolist (key '(print-buffer kill-buffer save-buffer - write-file dired open-file)) - (define-key tool-bar-map (vector key) nil)) - (message-tool-bar-local-item-from-menu - 'message-send-and-exit "mail/send" tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'message-kill-buffer "close" tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'message-dont-send "cancel" tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'mml-attach-file "attach" tool-bar-map mml-mode-map) - (message-tool-bar-local-item-from-menu - 'ispell-message "spell" tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'mml-preview "preview" - tool-bar-map mml-mode-map) - (message-tool-bar-local-item-from-menu - 'message-insert-importance-high "important" - tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'message-insert-importance-low "unimportant" - tool-bar-map message-mode-map) - (message-tool-bar-local-item-from-menu - 'message-insert-disposition-notification-to "receipt" - tool-bar-map message-mode-map) - tool-bar-map))))) + (or (not message-tool-bar-map) force)) + (setq message-tool-bar-map + (let* ((load-path + (gmm-image-load-path-for-library "message" + "mail/save-draft.xpm" + nil t)) + (image-load-path (cons (car load-path) + (when (boundp 'image-load-path) + image-load-path)))) + (gmm-tool-bar-from-list message-tool-bar + message-tool-bar-zap-list + 'message-mode-map)))) + message-tool-bar-map) ;;; Group name completion. diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index c58eb6bd41d..a10b8b28399 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -56,6 +56,8 @@ ;; known to break servers. ;; Note: UTF-16 variants are invalid for text parts [RFC 2781], ;; so this can't happen :-/. + ;; PPS: Yes, it can happen if the user specifies UTF-16 in the MML + ;; markup. - jh. (utf-16 . base64) (utf-16be . base64) (utf-16le . base64)) @@ -251,7 +253,10 @@ decoding. If it is nil, default to `mail-parse-charset'." (mm-decode-content-transfer-encoding encoding type)) (when (and (featurep 'mule) ;; Fixme: Wrong test for unibyte session. (not (eq charset 'gnus-decoded))) - (let ((coding-system (mm-charset-to-coding-system charset))) + (let ((coding-system (mm-charset-to-coding-system + ;; Allow overwrite using + ;; `mm-charset-override-alist'. + charset nil t))) (if (and (not coding-system) (listp mail-parse-ignored-charsets) (memq 'gnus-unknown mail-parse-ignored-charsets)) @@ -282,7 +287,11 @@ decoding. If it is nil, default to `mail-parse-charset'." (setq charset mail-parse-charset)) (or (when (featurep 'mule) - (let ((coding-system (mm-charset-to-coding-system charset))) + (let ((coding-system (mm-charset-to-coding-system + charset + ;; Allow overwrite using + ;; `mm-charset-override-alist'. + nil t))) (if (and (not coding-system) (listp mail-parse-ignored-charsets) (memq 'gnus-unknown mail-parse-ignored-charsets)) diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index a8c1f3a87a1..e16750cfcf6 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -177,6 +177,29 @@ system object in XEmacs." ;; no-MULE XEmacs: (car (memq cs (mm-get-coding-system-list)))))) +(defun mm-codepage-setup (number &optional alias) + "Create a coding system cpNUMBER. +The coding system is created using `codepage-setup'. If ALIAS is +non-nil, an alias is created and added to +`mm-charset-synonym-alist'. If ALIAS is a string, it's used as +the alias. Else windows-NUMBER is used." + (interactive + (let ((completion-ignore-case t) + (candidates (cp-supported-codepages))) + (list (completing-read "Setup DOS Codepage: (default 437) " candidates + nil t nil nil "437")))) + (when alias + (setq alias (if (stringp alias) + (intern alias) + (intern (format "windows-%s" number))))) + (let* ((cp (intern (format "cp%s" number)))) + (unless (mm-coding-system-p cp) + (codepage-setup number)) + (when (and alias + ;; Don't add alias if setup of cp failed. + (mm-coding-system-p cp)) + (add-to-list 'mm-charset-synonym-alist (cons alias cp))))) + (defvar mm-charset-synonym-alist `( ;; Not in XEmacs, but it's not a proper MIME charset anyhow. @@ -200,8 +223,61 @@ system object in XEmacs." ,@(if (and (not (mm-coding-system-p 'windows-1250)) (mm-coding-system-p 'cp1250)) '((windows-1250 . cp1250))) + ;; A Microsoft misunderstanding. + ,@(if (and (not (mm-coding-system-p 'unicode)) + (mm-coding-system-p 'utf-16-le)) + '((unicode . utf-16-le))) + ;; A Microsoft misunderstanding. + ,@(unless (mm-coding-system-p 'ks_c_5601-1987) + (if (mm-coding-system-p 'cp949) + '((ks_c_5601-1987 . cp949)) + '((ks_c_5601-1987 . euc-kr)))) ) - "A mapping from invalid charset names to the real charset names.") + "A mapping from unknown or invalid charset names to the real charset names.") + +(defcustom mm-charset-override-alist + `((iso-8859-1 . windows-1252)) + "A mapping from undesired charset names to their replacement. + +You may add pairs like (iso-8859-1 . windows-1252) here, +i.e. treat iso-8859-1 as windows-1252. windows-1252 is a +superset of iso-8859-1." + :type '(list (set :inline t + (const (iso-8859-1 . windows-1252)) + (const (undecided . windows-1252))) + (repeat :inline t + :tag "Other options" + (cons (symbol :tag "From charset") + (symbol :tag "To charset")))) + :version "23.0" ;; No Gnus + :group 'mime) + +(defcustom mm-charset-eval-alist + (if (featurep 'xemacs) + nil ;; I don't know what would be useful for XEmacs. + '(;; Emacs 21 offers 1250 1251 1253 1257. Emacs 22 provides autoloads for + ;; 1250-1258 (i.e. `mm-codepage-setup' does nothing). + (windows-1250 . (mm-codepage-setup 1250 t)) + (windows-1251 . (mm-codepage-setup 1251 t)) + (windows-1253 . (mm-codepage-setup 1253 t)) + (windows-1257 . (mm-codepage-setup 1257 t)))) + "An alist of (CHARSET . FORM) pairs. +If an article is encoded in an unknown CHARSET, FORM is +evaluated. This allows to load additional libraries providing +charsets on demand. If supported by your Emacs version, you +could use `autoload-coding-system' here." + :version "23.0" ;; No Gnus + :type '(list (set :inline t + (const (windows-1250 . (mm-codepage-setup 1250 t))) + (const (windows-1251 . (mm-codepage-setup 1251 t))) + (const (windows-1253 . (mm-codepage-setup 1253 t))) + (const (windows-1257 . (mm-codepage-setup 1257 t))) + (const (cp850 . (mm-codepage-setup 850 nil)))) + (repeat :inline t + :tag "Other options" + (cons (symbol :tag "charset") + (symbol :tag "form")))) + :group 'mime) (defvar mm-binary-coding-system (cond @@ -426,11 +502,17 @@ mail with multiple parts is preferred to sending a Unicode one.") (pop alist)) out))) -(defun mm-charset-to-coding-system (charset &optional lbt) +(defun mm-charset-to-coding-system (charset &optional lbt + allow-override) "Return coding-system corresponding to CHARSET. CHARSET is a symbol naming a MIME charset. If optional argument LBT (`unix', `dos' or `mac') is specified, it is -used as the line break code type of the coding system." +used as the line break code type of the coding system. + +If ALLOW-OVERRIDE is given, use `mm-charset-override-alist' to +map undesired charset names to their replacement. This should +only be used for decoding, not for encoding." + ;; OVERRIDE is used (only) in `mm-decode-body' and `mm-decode-string'. (when (stringp charset) (setq charset (intern (downcase charset)))) (when lbt @@ -442,6 +524,11 @@ used as the line break code type of the coding system." ((or (null (mm-get-coding-system-list)) (not (fboundp 'coding-system-get))) charset) + ;; Check override list quite early. Should only used for decoding, not for + ;; encoding! + ((and allow-override + (let ((cs (cdr (assq charset mm-charset-override-alist)))) + (and cs (mm-coding-system-p cs) cs)))) ;; ascii ((eq charset 'us-ascii) 'ascii) @@ -454,9 +541,27 @@ used as the line break code type of the coding system." ;;; (eq charset (coding-system-get charset 'mime-charset)) ) charset) + ;; Eval expressions from `mm-charset-eval-alist' + ((let* ((el (assq charset mm-charset-eval-alist)) + (cs (car el)) + (form (cdr el))) + (and cs + form + (prog2 + ;; Avoid errors... + (condition-case nil (eval form) (error nil)) + ;; (message "Failed to eval `%s'" form)) + (mm-coding-system-p cs) + (message "Added charset `%s' via `mm-charset-eval-alist'" cs)) + cs))) ;; Translate invalid charsets. ((let ((cs (cdr (assq charset mm-charset-synonym-alist)))) - (and cs (mm-coding-system-p cs) cs))) + (and cs + (mm-coding-system-p cs) + ;; (message + ;; "Using synonym `%s' from `mm-charset-synonym-alist' for `%s'" + ;; cs charset) + cs))) ;; Last resort: search the coding system list for entries which ;; have the right mime-charset in case the canonical name isn't ;; defined (though it should be). @@ -468,6 +573,11 @@ used as the line break code type of the coding system." (eq charset (or (coding-system-get c :mime-charset) (coding-system-get c 'mime-charset)))) (setq cs c))) + (unless cs + ;; Warn the user about unknown charset: + (if (fboundp 'gnus-message) + (gnus-message 7 "Unknown charset: %s" charset) + (message "Unknown charset: %s" charset))) cs)))) (defsubst mm-replace-chars-in-string (string from to) @@ -1070,7 +1180,8 @@ If SUFFIX is non-nil, add that at the end of the file name." (defun mm-detect-mime-charset-region (start end) "Detect MIME charset of the text in the region between START and END." (let ((cs (mm-detect-coding-region start end))) - (coding-system-get cs 'mime-charset))) + (or (coding-system-get cs :mime-charset) + (coding-system-get cs 'mime-charset)))) (defun mm-detect-mime-charset-region (start end) "Detect MIME charset of the text in the region between START and END." (let ((cs (mm-detect-coding-region start end))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 94621535154..a5cdf1f4d72 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -197,6 +197,7 @@ Commands: (view-mode) (make-local-variable 'view-no-disable-on-exit) (setq view-no-disable-on-exit t) + (setq view-exit-action (lambda (buffer) (delete-window))) (run-mode-hooks 'help-mode-hook)) ;;;###autoload diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 258f852a4d6..1a55676e3c7 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -139,7 +139,11 @@ and showing the image as an image." ;; was inserted (let* ((image (if (and (buffer-file-name) - (not (buffer-modified-p))) + (not (buffer-modified-p)) + (not (and (boundp 'archive-superior-buffer) + archive-superior-buffer)) + (not (and (boundp 'tar-superior-buffer) + tar-superior-buffer))) (progn (clear-image-cache) (create-image (buffer-file-name))) (create-image diff --git a/lisp/imenu.el b/lisp/imenu.el index 774903e1092..a609bcbadf9 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -208,18 +208,13 @@ during matching.") ;;;###autoload (defvar imenu-create-index-function 'imenu-default-create-index-function - "The function to use for creating a buffer index. + "The function to use for creating an index alist of the current buffer. -It should be a function that takes no arguments and returns an index -of the current buffer as an alist. +It should be a function that takes no arguments and returns +an index alist of the current buffer. The function is +called within a `save-excursion'. -Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION). -Special elements look like (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...). -A nested sub-alist element looks like (INDEX-NAME SUB-ALIST). -The function `imenu--subalist-p' tests an element and returns t -if it is a sub-alist. - -This function is called within a `save-excursion'.") +See `imenu--index-alist' for the format of the buffer index alist.") ;;;###autoload (make-variable-buffer-local 'imenu-create-index-function) @@ -431,15 +426,27 @@ Don't move point." ;; The latest buffer index. ;; Buffer local. (defvar imenu--index-alist nil - "The buffer index computed for this buffer in Imenu. -Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION). -Special elements look like (INDEX-NAME INDEX-POSITION FUNCTION ARGUMENTS...). -A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).") + "The buffer index alist computed for this buffer in Imenu. + +Simple elements in the alist look like (INDEX-NAME . POSITION). +POSITION is the buffer position of the item; to go to the item +is simply to move point to that position. + +Special elements look like (INDEX-NAME POSITION FUNCTION ARGUMENTS...). +To \"go to\" a special element means applying FUNCTION +to INDEX-NAME, POSITION, and the ARGUMENTS. + +A nested sub-alist element looks like (INDEX-NAME SUB-ALIST). +The function `imenu--subalist-p' tests an element and returns t +if it is a sub-alist. + +There is one simple element with negative POSITION; selecting that +element recalculates the buffer's index alist.") (make-variable-buffer-local 'imenu--index-alist) (defvar imenu--last-menubar-index-alist nil - "The latest buffer index used to update the menu bar menu.") + "The latest buffer index alist used to update the menu bar menu.") (make-variable-buffer-local 'imenu--last-menubar-index-alist) @@ -547,19 +554,12 @@ A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).") (defun imenu--make-index-alist (&optional noerror) - "Create an index-alist for the definitions in the current buffer. - + "Create an index alist for the definitions in the current buffer. +This works by using the hook function `imenu-create-index-function'. Report an error if the list is empty unless NOERROR is supplied and non-nil. -Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION). -Special elements look like (INDEX-NAME FUNCTION ARGUMENTS...). -A nested sub-alist element looks like (INDEX-NAME SUB-ALIST). -The function `imenu--subalist-p' tests an element and returns t -if it is a sub-alist. - -There is one simple element with negative POSITION; that's intended -as a way for the user to ask to recalculate the buffer's index alist." +See `imenu--index-alist' for the format of the index alist." (or (and imenu--index-alist (or (not imenu-auto-rescan) (and imenu-auto-rescan @@ -657,11 +657,15 @@ and speed-up matching.") (make-variable-buffer-local 'imenu-syntax-alist) (defun imenu-default-create-index-function () - "*Wrapper for index searching functions. + "*Default function to create an index alist of the current buffer. -Moves point to end of buffer and then repeatedly calls +The most general method is to move point to end of buffer, then repeatedly call `imenu-prev-index-position-function' and `imenu-extract-index-name-function'. -Their results are gathered into an index alist." +All the results returned by the latter are gathered into an index alist. +This method is used if those two variables are non-nil. + +The alternate method, which is the one most often used, is to call +`imenu--generic-function' with `imenu-generic-expression' as argument." ;; These should really be done by setting imenu-create-index-function ;; in these major modes. But save that change for later. (cond ((and imenu-prev-index-position-function @@ -687,27 +691,6 @@ Their results are gathered into an index alist." (t (error "This buffer cannot use `imenu-default-create-index-function'")))) -;; Not used and would require cl at run time -;; (defun imenu--flatten-index-alist (index-alist &optional concat-names prefix) -;; ;; Takes a nested INDEX-ALIST and returns a flat index alist. -;; ;; If optional CONCAT-NAMES is non-nil, then a nested index has its -;; ;; name and a space concatenated to the names of the children. -;; ;; Third argument PREFIX is for internal use only. -;; (mapcan -;; (lambda (item) -;; (let* ((name (car item)) -;; (pos (cdr item)) -;; (new-prefix (and concat-names -;; (if prefix -;; (concat prefix imenu-level-separator name) -;; name)))) -;; (cond -;; ((or (markerp pos) (numberp pos)) -;; (list (cons new-prefix pos))) -;; (t -;; (imenu--flatten-index-alist pos new-prefix))))) -;; index-alist)) - ;;; ;;; Generic index gathering function. ;;; @@ -724,7 +707,7 @@ for modes which use `imenu--generic-function'. If it is not set, but ;; This function can be called with quitting disabled, ;; so it needs to be careful never to loop! (defun imenu--generic-function (patterns) - "Return an index of the current buffer as an alist. + "Return an index alist of the current buffer based on PATTERNS. PATTERNS is an alist with elements that look like this: (MENU-TITLE REGEXP INDEX) @@ -732,9 +715,8 @@ or like this: (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...) with zero or more ARGUMENTS. The former format creates a simple element in the index alist when it matches; the latter creates a -special element of the form (NAME POSITION-MARKER FUNCTION -ARGUMENTS...) with FUNCTION and ARGUMENTS copied from -`imenu-generic-expression'. +special element of the form (INDEX-NAME POSITION-MARKER FUNCTION +ARGUMENTS...) with FUNCTION and ARGUMENTS copied from PATTERNS. MENU-TITLE is a string used as the title for the submenu or nil if the entries are not nested. diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 6bf84517bde..72c7a87f257 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,172 @@ +2006-04-18 Bill Wohler <wohler@newt.com> + + * mh-e.el (defcustom-mh, defface-mh, defgroup-mh, mh-face-data) + (mh-strip-package-version, mh-face-data, mh-inherit-face-flag) + (mh-min-colors-defined-flag): Do not unbind these macros and + variables. Nice idea, but too many nasty side-effects. These + macros are needed by [Cc]ustom-make-dependencies when creating the + MH-E customization groups in mh-cus-load.el. These disappeared + when the macros above were introduced. Besides, if a developer + were to try to show the help for a macro or variable they were + looking at and got [No match] when they did so, that would be bad. + +2006-04-17 Bill Wohler <wohler@newt.com> + + * mh-comp.el (mh-insert-x-mailer): Strip build number from + version in X-Mailer field (closes SF #1466481). + + * mh-acros.el (mh-defun-compat): Rename to defun-mh in order that + variables and functions with the same name are found correctly by + find-func (invoked by clicking on the filename link in the *Help* + buffer). + (mh-defmacro-compat): Rename to defmacro-mh. Ditto. + * mh-e.el: (mh-defgroup): Rename to defgroup-mh. Ditto. + (mh-defcustom): Rename to defcustom-mh. Ditto. + (mh-defface): Rename to defface-mh. Ditto. + (mh-font-lock-add-keywords): Make changes according to these + renamings. + + * mh-e.el, mh-compat.el, mh-gnus.el: Use the new names (closes SF + #1472029). + + * mh-utils.el (mh-sub-folders-actual): Mention that folder must + have been processed by mh-normalize-folder-name. + (mh-folder-completion-function): Handle completion of folders with + absolute names. Also, when flag is t, display complete folder name + to provide proper highlighting in Emacs 22 now that + minibuffer-completing-file-name is nil (closes SF #1470518). + (mh-folder-completing-read): No longer set + minibuffer-completing-file-name to t. This was causing "Can't set + current directory errors" when browsing absolute file names. + Another benefit of this change is that SPC can be used for + completion again (closes SF #1470518). + +2006-04-15 Bill Wohler <wohler@newt.com> + + * mh-compat.el (mh-font-lock-add-keywords): Fix typo in docstring. + +2006-04-14 Bill Wohler <wohler@newt.com> + + * mh-funcs.el (view-exit-action): No need to wrap defvar with + eval-when-compile when shushing compiler. + + * mh-mime.el (mh-identity-pgg-default-user-id): Ditto. + + * mh-seq.el (view-exit-action): Ditto. + + * mh-show.el (font-lock-auto-fontify): Ditto. + + * mh-utils.el (mh-speed-flists-cache): Ditto + + * mh-acros.el (struct, x, y): No need to wrap defvar with + eval-when-compile when shushing compiler, even when + mh-do-in-xemacs or another construct is used. + + * mh-comp.el (sendmail-coding-system): Ditto. + + * mh-e.el (mark-active): Ditto. + + * mh-folder.el (desktop-save-buffer, font-lock-auto-fontify) + (image-load-path, font-lock-defaults): Ditto. + + * mh-letter.el (image-load-path, font-lock-defaults): Ditto. + + * mh-mime.el (dots, type, ov) + (mm-verify-function-alist, mm-decrypt-function-alist) + (pressed-details): Ditto. + + * mh-search.el (pick-folder, mh-do-in-xemacs) + (mh-mairix-folder, mh-flists-search-folders) + (which-func-mode, mh-speed-flists-inhibit-flag): Ditto. + + * mh-seq.el (tool-bar-mode): Ditto. + + * mh-utils.el (completion-root-regexp) + (minibuffer-completing-file-name): Ditto. + + * mh-xface.el (default-enable-multibyte-characters): Ditto. + + * mh-compat.el (mh-font-lock-add-keywords): New alias for + font-lock-add-keywords. Returns nil on XEmacs. + + * mh-e.el: Add MH-E function and variable keywords such as + mh-defun-compat and mh-defcustom to font-lock-keywords. + +2006-04-13 Bill Wohler <wohler@newt.com> + + * mh-e.el (customize-package-emacs-version-alist) + (mh-e, mh-alias, mh-folder, mh-folder-selection) + (mh-identity, mh-inc, mh-junk, mh-letter, mh-ranges) + (mh-scan-line-formats, mh-search, mh-sending-mail, ) + (mh-sequences, mh-show, mh-speedbar, mh-thread, mh-tool-bar) + (mh-hooks, mh-faces, mh-alias-completion-ignore-case-flag) + (mh-alias-expand-aliases-flag, mh-alias-flash-on-comma) + (mh-alias-insert-file, mh-alias-insertion-location) + (mh-alias-local-users, mh-alias-local-users-prefix) + (mh-alias-passwd-gecos-comma-separator-flag) + (mh-new-messages-folders, mh-ticked-messages-folders) + (mh-large-folder, mh-recenter-summary-flag) + (mh-recursive-folders-flag, mh-sortm-args) + (mh-default-folder-for-message-function, ) + (mh-default-folder-list, mh-default-folder-must-exist-flag) + (mh-default-folder-prefix, mh-identity-list) + (mh-auto-fields-list, mh-auto-fields-prompt-flag) + (mh-identity-default, mh-identity-handlers, mh-inc-prog) + (mh-inc-spool-list, mh-junk-background, mh-junk-disposition) + (mh-junk-program, mh-compose-insertion) + (mh-compose-skipped-header-fields) + (mh-compose-space-does-completion-flag) + (mh-delete-yanked-msg-window-flag) + (mh-extract-from-attribution-verb, mh-ins-buf-prefix) + (mh-letter-complete-function, mh-letter-fill-column) + (mh-mml-method-default, mh-signature-file-name) + (mh-signature-separator-flag, mh-x-face-file, ) + (mh-yank-behavior, mh-interpret-number-as-range-flag) + (mh-adaptive-cmd-note-flag, mh-scan-format-file, mh-scan-prog) + (mh-search-program, mh-compose-forward-as-mime-flag) + (mh-compose-letter-function, mh-compose-prompt-flag) + (mh-forward-subject-format, mh-insert-x-mailer-flag) + (mh-redist-full-contents-flag, mh-reply-default-reply-to) + (mh-reply-show-message-flag, ) + (mh-refile-preserves-sequences-flag, mh-tick-seq) + (mh-update-sequences-after-mh-show-flag) + (mh-bury-show-buffer-flag, mh-clean-message-header-flag) + (mh-decode-mime-flag, ) + (mh-display-buttons-for-alternatives-flag) + (mh-display-buttons-for-inline-parts-flag) + (mh-do-not-confirm-flag, mh-fetch-x-image-url) + (mh-graphical-smileys-flag, mh-graphical-emphasis-flag) + (mh-highlight-citation-style, mh-invisible-header-fields) + (mh-invisible-header-fields-default, mh-lpr-command-format) + (mh-max-inline-image-height, mh-max-inline-image-width) + (mh-mhl-format-file, mh-mime-save-parts-default-directory) + (mh-print-background-flag, mh-show-maximum-size) + (mh-show-use-xface-flag, mh-store-default-directory) + (mh-summary-height, mh-speed-update-interval) + (mh-show-threads-flag, mh-tool-bar-search-function) + (mh-defcustom, mh-after-commands-processed-hook) + (mh-alias-reloaded-hook, mh-before-commands-processed-hook) + (mh-before-quit-hook, mh-before-send-letter-hook) + (mh-delete-msg-hook, mh-find-path-hook, mh-folder-mode-hook) + (mh-forward-hook, mh-inc-folder-hook, ) + (mh-insert-signature-hook, ) + (mh-kill-folder-suppress-prompt-hooks, mh-letter-mode-hook) + (mh-mh-to-mime-hook, mh-search-mode-hook, mh-quit-hook) + (mh-refile-msg-hook, mh-show-hook, mh-show-mode-hook) + (mh-unseen-updated-hook, mh-folder-address, mh-folder-body) + (mh-folder-cur-msg-number, mh-folder-date, mh-folder-deleted) + (mh-folder-followup, mh-folder-msg-number, mh-folder-refiled) + (mh-folder-sent-to-me-hint, mh-folder-sent-to-me-sender) + (mh-folder-subject, mh-folder-tick, mh-folder-to) + (mh-letter-header-field, mh-search-folder, mh-show-cc) + (mh-show-date, mh-show-from, mh-show-header, mh-show-pgg-bad) + (mh-show-pgg-good, mh-show-pgg-unknown, mh-show-signature) + (mh-show-subject, mh-show-to, mh-show-xface, ) + (mh-speedbar-folder, mh-speedbar-folder-with-unseen-messages) + (mh-speedbar-selected-folder) + (mh-speedbar-selected-folder-with-unseen-messages): Use dotted + notation in :package-version keyword. + 2006-04-07 Bill Wohler <wohler@newt.com> * mh-e.el (mh-path, mh-variant): Define with mh-defcustom and add @@ -21,7 +190,7 @@ (mh-scan-line-formats, mh-search, mh-sending-mail) (mh-sequences, mh-show, mh-speedbar, mh-thread, mh-tool-bar) (mh-hooks, mh-faces): Add :package-version keyword to these - groups. + groups (closes SF #1452724). (mh-alias-completion-ignore-case-flag) (mh-alias-expand-aliases-flag, mh-alias-flash-on-comma) (mh-alias-insert-file, mh-alias-insertion-location) @@ -67,7 +236,7 @@ (mh-show-use-xface-flag, mh-store-default-directory) (mh-summary-height, mh-speed-update-interval) (mh-show-threads-flag, mh-tool-bar-search-function): Add - :package-version keyword to these options. + :package-version keyword to these options (closes SF #1452724). (mh-after-commands-processed-hook) (mh-alias-reloaded-hook, mh-before-commands-processed-hook) (mh-before-quit-hook, mh-before-send-letter-hook) @@ -78,7 +247,7 @@ (mh-mh-to-mime-hook, mh-search-mode-hook, mh-quit-hook) (mh-refile-msg-hook, mh-show-hook, mh-show-mode-hook) (mh-unseen-updated-hook): Add :package-version keyword to these - hooks. + hooks (closes SF #1452724). (mh-min-colors-defined-flag) (mh-folder-address, mh-folder-body, mh-folder-cur-msg-number) (mh-folder-date, mh-folder-deleted, mh-folder-followup) @@ -92,10 +261,10 @@ (mh-speedbar-folder, mh-speedbar-folder-with-unseen-messages) (mh-speedbar-selected-folder) (mh-speedbar-selected-folder-with-unseen-messages): : Add - :package-version keyword to these faces. + :package-version keyword to these faces (closes SF #1452724). * mh-tool-bar.el (mh-tool-bar-define): Added commented-out - :package-version keywords. + :package-version keywords (closes SF #1452724). 2006-03-28 Bill Wohler <wohler@newt.com> diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el index 8f38abc56ee..9fa69fae5d9 100644 --- a/lisp/mh-e/mh-acros.el +++ b/lisp/mh-e/mh-acros.el @@ -82,7 +82,7 @@ loads \"cl\" appropriately." (funcall ',function ,@args)))) ;;;###mh-autoload -(defmacro mh-defun-compat (name function arg-list &rest body) +(defmacro defun-mh (name function arg-list &rest body) "Create function NAME. If FUNCTION exists, then NAME becomes an alias for FUNCTION. Otherwise, create function NAME with ARG-LIST and BODY." @@ -90,10 +90,10 @@ Otherwise, create function NAME with ARG-LIST and BODY." (if defined-p `(defalias ',name ',function) `(defun ,name ,arg-list ,@body)))) -(put 'mh-defun-compat 'lisp-indent-function 'defun) +(put 'defun-mh 'lisp-indent-function 'defun) ;;;###mh-autoload -(defmacro mh-defmacro-compat (name macro arg-list &rest body) +(defmacro defmacro-mh (name macro arg-list &rest body) "Create macro NAME. If MACRO exists, then NAME becomes an alias for MACRO. Otherwise, create macro NAME with ARG-LIST and BODY." @@ -101,7 +101,7 @@ Otherwise, create macro NAME with ARG-LIST and BODY." (if defined-p `(defalias ',name ',macro) `(defmacro ,name ,arg-list ,@body)))) -(put 'mh-defmacro-compat 'lisp-indent-function 'defun) +(put 'defmacro-mh 'lisp-indent-function 'defun) @@ -130,7 +130,9 @@ check if variable `transient-mark-mode' is active." (boundp 'mark-active) mark-active)))) ;; Shush compiler. -(eval-when-compile (mh-do-in-xemacs (defvar struct) (defvar x) (defvar y))) +(defvar struct) ; XEmacs +(defvar x) ; XEmacs +(defvar y) ; XEmacs ;;;###mh-autoload (defmacro mh-defstruct (name-spec &rest fields) diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 27806dc9ab9..ad80e3be838 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -215,7 +215,7 @@ ignored." (setq other-headers (cdr other-headers))))) ;; Shush compiler. -(eval-when-compile (mh-do-in-xemacs (defvar sendmail-coding-system))) +(defvar sendmail-coding-system) ; XEmacs ;;;###autoload (defun mh-send-letter (&optional arg) @@ -912,7 +912,10 @@ The versions of MH-E, Emacs, and MH are shown." (format "MH-E %s; %s; %sEmacs %s" mh-version mh-variant-in-use (if mh-xemacs-flag "X" "GNU ") - (cond ((not mh-xemacs-flag) emacs-version) + (cond ((not mh-xemacs-flag) + (string-match "[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)?" + emacs-version) + (match-string 0 emacs-version)) ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?" emacs-version) (match-string 0 emacs-version)) diff --git a/lisp/mh-e/mh-compat.el b/lisp/mh-e/mh-compat.el index 256a8cfe831..b346a41fad7 100644 --- a/lisp/mh-e/mh-compat.el +++ b/lisp/mh-e/mh-compat.el @@ -40,7 +40,7 @@ ;; versions of Gnus. ;; Items are listed alphabetically (except for mh-require which is -;; needed by a lesser character). +;; needed sooner it would normally appear). (require 'mh-acros) @@ -62,7 +62,7 @@ Simulate NOERROR argument in XEmacs which lacks it." (load filename noerror t) (load (format "%s" feature) noerror t))))) -(mh-defun-compat mh-assoc-string assoc-string (key list case-fold) +(defun-mh mh-assoc-string assoc-string (key list case-fold) "Like `assoc' but specifically for strings. Case is ignored if CASE-FOLD is non-nil. This function is used by Emacs versions that lack `assoc-string', @@ -77,7 +77,7 @@ introduced in Emacs 22." 'cancel-timer 'delete-itimer)) -(mh-defun-compat mh-display-color-cells display-color-cells (&optional display) +(defun-mh mh-display-color-cells display-color-cells (&optional display) "Return the number of color cells supported by DISPLAY. This function is used by XEmacs to return 2 when `device-color-cells' returns nil. This happens when compiling or @@ -115,7 +115,12 @@ introduced in Emacs 22." `(face-background ,face ,frame) `(face-background ,face ,frame ,inherit))) -(mh-defun-compat mh-image-load-path-for-library +(defun-mh mh-font-lock-add-keywords font-lock-add-keywords + (mode keywords &optional how) + "XEmacs does not have `font-lock-add-keywords'. +This function returns nil on that system.") + +(defun-mh mh-image-load-path-for-library image-load-path-for-library (library image &optional path no-error) "Return a suitable search path for images used by LIBRARY. @@ -210,7 +215,7 @@ compatibility with versions of Emacs that lack the variable (nconc (list image-directory) (delete image-directory (copy-sequence (or path load-path)))))) -(mh-defun-compat mh-image-search-load-path +(defun-mh mh-image-search-load-path image-search-load-path (file &optional path) "Emacs 21 and XEmacs don't have `image-search-load-path'. This function returns nil on those systems." @@ -229,13 +234,13 @@ This function returns nil on those systems." 'point-at-eol)) (mh-require 'mailabbrev nil t) -(mh-defun-compat mh-mail-abbrev-make-syntax-table +(defun-mh mh-mail-abbrev-make-syntax-table mail-abbrev-make-syntax-table () "Emacs 21 and XEmacs don't have `mail-abbrev-make-syntax-table'. This function returns nil on those systems." nil) -(mh-defun-compat mh-match-string-no-properties +(defun-mh mh-match-string-no-properties match-string-no-properties (num &optional string) "Return string of text matched by last search, without text properties. This function is used by XEmacs that lacks `match-string-no-properties'. @@ -244,7 +249,7 @@ The argument STRING is ignored." (buffer-substring-no-properties (match-beginning num) (match-end num))) -(mh-defun-compat mh-replace-regexp-in-string replace-regexp-in-string +(defun-mh mh-replace-regexp-in-string replace-regexp-in-string (regexp rep string &optional fixedcase literal subexp start) "Replace REGEXP with REP everywhere in STRING and return result. This function is used by XEmacs that lacks `replace-regexp-in-string'. @@ -264,7 +269,7 @@ The arguments FIXEDCASE, SUBEXP, and START, used by "A list of characters that are _NOT_ reserved in the URL spec. This is taken from RFC 2396.")) -(mh-defun-compat mh-url-hexify-string url-hexify-string (str) +(defun-mh mh-url-hexify-string url-hexify-string (str) "Escape characters in a string. This is a copy of `url-hexify-string' from url-util.el in Emacs 22; needed by Emacs 21." @@ -278,7 +283,7 @@ This is a copy of `url-hexify-string' from url-util.el in Emacs (char-to-string char))) str "")) -(mh-defun-compat mh-view-mode-enter +(defun-mh mh-view-mode-enter view-mode-enter (&optional return-to exit-action) "Enter View mode. This function is used by XEmacs that lacks `view-mode-enter'. diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index a2d0e85841b..9ae686d8950 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -109,6 +109,26 @@ (require 'mh-buffers) (require 'mh-compat) +(mh-font-lock-add-keywords + 'emacs-lisp-mode + (eval-when-compile + `((,(concat "(\\(" + ;; Function declarations (use font-lock-function-name-face). + "\\(def\\(un\\|macro\\)-mh\\)\\|" + ;; Variable declarations (use font-lock-variable-name-face). + "\\(def\\(custom\\|face\\)-mh\\)\\|" + ;; Group declarations (use font-lock-type-face). + "\\(defgroup-mh\\)" + "\\)\\>" + ;; Any whitespace and defined object. + "[ \t'\(]*" + "\\(setf[ \t]+\\sw+)\\|\\sw+\\)?") + (1 font-lock-keyword-face) + (7 (cond ((match-beginning 2) font-lock-function-name-face) + ((match-beginning 4) font-lock-variable-name-face) + (t font-lock-type-face)) + nil t))))) + ;;; Global Variables @@ -603,7 +623,7 @@ Output is expected to be shown to user, not parsed by MH-E." (mh-exchange-point-and-mark-preserving-active-mark)) ;; Shush compiler. -(eval-when-compile (mh-do-in-xemacs (defvar mark-active))) +(defvar mark-active) ; XEmacs (defun mh-exchange-point-and-mark-preserving-active-mark () "Put the mark where point is now, and point where the mark is now. @@ -664,7 +684,7 @@ ARGS is returned unchanged." (t t)) collect keyword)))) -(defmacro mh-defgroup (symbol members doc &rest args) +(defmacro defgroup-mh (symbol members doc &rest args) "Declare SYMBOL as a customization group containing MEMBERS. See documentation for `defgroup' for a description of the arguments SYMBOL, MEMBERS, DOC and ARGS. @@ -672,9 +692,9 @@ This macro is used by Emacs versions that lack the :package-version keyword, introduced in Emacs 22." (declare (doc-string 3)) `(defgroup ,symbol ,members ,doc ,@(mh-strip-package-version args))) -(put 'mh-defgroup 'lisp-indent-function 'defun) +(put 'defgroup-mh 'lisp-indent-function 'defun) -(defmacro mh-defcustom (symbol value doc &rest args) +(defmacro defcustom-mh (symbol value doc &rest args) "Declare SYMBOL as a customizable variable that defaults to VALUE. See documentation for `defcustom' for a description of the arguments SYMBOL, VALUE, DOC and ARGS. @@ -682,9 +702,9 @@ This macro is used by Emacs versions that lack the :package-version keyword, introduced in Emacs 22." (declare (doc-string 3)) `(defcustom ,symbol ,value ,doc ,@(mh-strip-package-version args))) -(put 'mh-defcustom 'lisp-indent-function 'defun) +(put 'defcustom-mh 'lisp-indent-function 'defun) -(defmacro mh-defface (face spec doc &rest args) +(defmacro defface-mh (face spec doc &rest args) "Declare FACE as a customizable face that defaults to SPEC. See documentation for `defface' for a description of the arguments FACE, SPEC, DOC and ARGS. @@ -692,13 +712,13 @@ This macro is used by Emacs versions that lack the :package-version keyword, introduced in Emacs 22." (declare (doc-string 3)) `(defface ,face ,spec ,doc ,@(mh-strip-package-version args))) -(put 'mh-defface 'lisp-indent-function 'defun) +(put 'defface-mh 'lisp-indent-function 'defun) ;;; Variant Support -(mh-defcustom mh-path nil +(defcustom-mh mh-path nil "*Additional list of directories to search for MH. See `mh-variant'." :group 'mh-e @@ -912,7 +932,7 @@ finally GNU mailutils." (mapconcat '(lambda (x) (format "%s" (car x))) (mh-variants) " or ")))))) -(mh-defcustom mh-variant 'autodetect +(defcustom-mh mh-variant 'autodetect "*Specifies the variant used by MH-E. The default setting of this option is \"Auto-detect\" which means @@ -989,148 +1009,148 @@ windows in the frame are removed." (if (boundp 'customize-package-emacs-version-alist) (add-to-list 'customize-package-emacs-version-alist - '(MH-E ("6.0" "22.1") ("6.1" "22.1") ("7.0" "22.1") - ("7.1" "22.1") ("7.2" "22.1") ("7.3" "22.1") - ("7.4" "22.1") ("8.0" "22.1")))) + '(MH-E ("6.0" . "22.1") ("6.1" . "22.1") ("7.0" . "22.1") + ("7.1" . "22.1") ("7.2" . "22.1") ("7.3" . "22.1") + ("7.4" . "22.1") ("8.0" . "22.1")))) ;;; MH-E Customization Groups -(mh-defgroup mh-e nil +(defgroup-mh mh-e nil "Emacs interface to the MH mail system. MH is the Rand Mail Handler. Other implementations include nmh and GNU mailutils." :link '(custom-manual "(mh-e)Top") :group 'mail - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-alias nil +(defgroup-mh mh-alias nil "Aliases." :link '(custom-manual "(mh-e)Aliases") :prefix "mh-alias-" :group 'mh-e - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defgroup mh-folder nil +(defgroup-mh mh-folder nil "Organizing your mail with folders." :prefix "mh-" :link '(custom-manual "(mh-e)Folders") :group 'mh-e - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defgroup mh-folder-selection nil +(defgroup-mh mh-folder-selection nil "Folder selection." :prefix "mh-" :link '(custom-manual "(mh-e)Folder Selection") :group 'mh-e - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-identity nil +(defgroup-mh mh-identity nil "Identities." :link '(custom-manual "(mh-e)Identities") :prefix "mh-identity-" :group 'mh-e - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defgroup mh-inc nil +(defgroup-mh mh-inc nil "Incorporating your mail." :prefix "mh-inc-" :link '(custom-manual "(mh-e)Incorporating Mail") :group 'mh-e - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-junk nil +(defgroup-mh mh-junk nil "Dealing with junk mail." :link '(custom-manual "(mh-e)Junk") :prefix "mh-junk-" :group 'mh-e - :package-version '(MH-E "7.3")) + :package-version '(MH-E . "7.3")) -(mh-defgroup mh-letter nil +(defgroup-mh mh-letter nil "Editing a draft." :prefix "mh-" :link '(custom-manual "(mh-e)Editing Drafts") :group 'mh-e - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defgroup mh-ranges nil +(defgroup-mh mh-ranges nil "Ranges." :prefix "mh-" :link '(custom-manual "(mh-e)Ranges") :group 'mh-e - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-scan-line-formats nil +(defgroup-mh mh-scan-line-formats nil "Scan line formats." :link '(custom-manual "(mh-e)Scan Line Formats") :prefix "mh-" :group 'mh-e - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-search nil +(defgroup-mh mh-search nil "Searching." :link '(custom-manual "(mh-e)Searching") :prefix "mh-search-" :group 'mh-e - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-sending-mail nil +(defgroup-mh mh-sending-mail nil "Sending mail." :prefix "mh-" :link '(custom-manual "(mh-e)Sending Mail") :group 'mh-e - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-sequences nil +(defgroup-mh mh-sequences nil "Sequences." :prefix "mh-" :link '(custom-manual "(mh-e)Sequences") :group 'mh-e - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-show nil +(defgroup-mh mh-show nil "Reading your mail." :prefix "mh-" :link '(custom-manual "(mh-e)Reading Mail") :group 'mh-e - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defgroup mh-speedbar nil +(defgroup-mh mh-speedbar nil "The speedbar." :prefix "mh-speed-" :link '(custom-manual "(mh-e)Speedbar") :group 'mh-e - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-thread nil +(defgroup-mh mh-thread nil "Threading." :prefix "mh-thread-" :link '(custom-manual "(mh-e)Threading") :group 'mh-e - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-tool-bar nil +(defgroup-mh mh-tool-bar nil "The tool bar" :link '(custom-manual "(mh-e)Tool Bar") :prefix "mh-" :group 'mh-e - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defgroup mh-hooks nil +(defgroup-mh mh-hooks nil "MH-E hooks." :link '(custom-manual "(mh-e)Top") :prefix "mh-" :group 'mh-e - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defgroup mh-faces nil +(defgroup-mh mh-faces nil "Faces used in MH-E." :link '(custom-manual "(mh-e)Top") :prefix "mh-" :group 'faces :group 'mh-e - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) @@ -1140,7 +1160,7 @@ and GNU mailutils." ;;; Aliases (:group 'mh-alias) -(mh-defcustom mh-alias-completion-ignore-case-flag t +(defcustom-mh mh-alias-completion-ignore-case-flag t "*Non-nil means don't consider case significant in MH alias completion. As MH ignores case in the aliases, so too does MH-E. However, you @@ -1149,9 +1169,9 @@ used to segregate completion of your aliases. You might use lowercase for mailing lists and uppercase for people." :type 'boolean :group 'mh-alias - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-expand-aliases-flag nil +(defcustom-mh mh-alias-expand-aliases-flag nil "*Non-nil means to expand aliases entered in the minibuffer. In other words, aliases entered in the minibuffer will be @@ -1159,9 +1179,9 @@ expanded to the full address in the message draft. By default, this expansion is not performed." :type 'boolean :group 'mh-alias - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-flash-on-comma t +(defcustom-mh mh-alias-flash-on-comma t "*Specify whether to flash address or warn on translation. This option controls the behavior when a [comma] is pressed while @@ -1172,9 +1192,9 @@ does not display a warning if the alias is not found." (const :tag "Flash and Warn If No Alias" 1) (const :tag "Don't Flash Nor Warn If No Alias" nil)) :group 'mh-alias - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-insert-file nil +(defcustom-mh mh-alias-insert-file nil "*Filename used to store a new MH-E alias. The default setting of this option is \"Use Aliasfile Profile @@ -1186,9 +1206,9 @@ name, MH-E will prompt for one of them when MH-E adds an alias." (file :tag "Alias File") (repeat :tag "List of Alias Files" file)) :group 'mh-alias - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-insertion-location 'sorted +(defcustom-mh mh-alias-insertion-location 'sorted "Specifies where new aliases are entered in alias files. This option is set to \"Alphabetical\" by default. If you organize @@ -1198,9 +1218,9 @@ or \"Bottom\" of your alias file might be more appropriate." (const :tag "Top" top) (const :tag "Bottom" bottom)) :group 'mh-alias - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-local-users t +(defcustom-mh mh-alias-local-users t "*If on, local users are added to alias completion. Aliases are created from \"/etc/passwd\" entries with a user ID @@ -1219,9 +1239,9 @@ password file. For example, use \"ypcat passwd\" to obtain the NIS password file." :type '(choice (boolean) (string)) :group 'mh-alias - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defcustom mh-alias-local-users-prefix "local." +(defcustom-mh mh-alias-local-users-prefix "local." "*String prefixed to the real names of users from the password file. This option can also be set to \"Use Login\". @@ -1241,9 +1261,9 @@ turned off." :type '(choice (const :tag "Use Login" nil) (string)) :group 'mh-alias - :package-version '(MH-E "7.4")) + :package-version '(MH-E . "7.4")) -(mh-defcustom mh-alias-passwd-gecos-comma-separator-flag t +(defcustom-mh mh-alias-passwd-gecos-comma-separator-flag t "*Non-nil means the gecos field in the password file uses a comma separator. In the example in `mh-alias-local-users-prefix', commas are used @@ -1253,11 +1273,11 @@ gecos field in your password file is not separated by commas and whose contents may contain commas, you can turn this option off." :type 'boolean :group 'mh-alias - :package-version '(MH-E "7.4")) + :package-version '(MH-E . "7.4")) ;;; Organizing Your Mail with Folders (:group 'mh-folder) -(mh-defcustom mh-new-messages-folders t +(defcustom-mh mh-new-messages-folders t "Folders searched for the \"unseen\" sequence. Set this option to \"Inbox\" to search the \"+inbox\" folder or @@ -1270,9 +1290,9 @@ See also `mh-recursive-folders-flag'." (const :tag "All" nil) (repeat :tag "Choose Folders" (string :tag "Folder"))) :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-ticked-messages-folders t +(defcustom-mh mh-ticked-messages-folders t "Folders searched for `mh-tick-seq'. Set this option to \"Inbox\" to search the \"+inbox\" folder or @@ -1285,9 +1305,9 @@ See also `mh-recursive-folders-flag'." (const :tag "All" nil) (repeat :tag "Choose Folders" (string :tag "Folder"))) :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-large-folder 200 +(defcustom-mh mh-large-folder 200 "The number of messages that indicates a large folder. If a folder is deemed to be large, that is the number of messages @@ -1297,24 +1317,24 @@ is not automatically threaded, if it is large. If set to nil all folders are treated as if they are small." :type '(choice (const :tag "No Limit") integer) :group 'mh-folder - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-recenter-summary-flag nil +(defcustom-mh mh-recenter-summary-flag nil "*Non-nil means to recenter the summary window. If this option is turned on, recenter the summary window when the show window is toggled off." :type 'boolean :group 'mh-folder - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-recursive-folders-flag nil +(defcustom-mh mh-recursive-folders-flag nil "*Non-nil means that commands which operate on folders do so recursively." :type 'boolean :group 'mh-folder - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-sortm-args nil +(defcustom-mh mh-sortm-args nil "*Additional arguments for \"sortm\"\\<mh-folder-mode-map>. This option is consulted when a prefix argument is used with @@ -1324,11 +1344,11 @@ an alternate view. For example, \"'(\"-nolimit\" \"-textfield\" \"subject\")\" is a useful setting." :type 'string :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) ;;; Folder Selection (:group 'mh-folder-selection) -(mh-defcustom mh-default-folder-for-message-function nil +(defcustom-mh mh-default-folder-for-message-function nil "Function to select a default folder for refiling or \"Fcc:\". When this function is called, the current buffer contains the message @@ -1338,9 +1358,9 @@ sign. It can also return nil so that the last folder name is used as the default, or an empty string to suppress the default entirely." :type 'function :group 'mh-folder-selection - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-default-folder-list nil +(defcustom-mh mh-default-folder-list nil "*List of addresses and folders. The folder name associated with the first address found in this @@ -1356,9 +1376,9 @@ for more information." (string :tag "Folder") (boolean :tag "Check Recipient"))) :group 'mh-folder-selection - :package-version '(MH-E "7.2")) + :package-version '(MH-E . "7.2")) -(mh-defcustom mh-default-folder-must-exist-flag t +(defcustom-mh mh-default-folder-must-exist-flag t "*Non-nil means guessed folder name must exist to be used. If the derived folder does not exist, and this option is on, then @@ -1370,9 +1390,9 @@ See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more information." :type 'boolean :group 'mh-folder-selection - :package-version '(MH-E "7.2")) + :package-version '(MH-E . "7.2")) -(mh-defcustom mh-default-folder-prefix "" +(defcustom-mh mh-default-folder-prefix "" "*Prefix used for folder names generated from aliases. The prefix is used to prevent clutter in your mail directory. @@ -1380,7 +1400,7 @@ See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more information." :type 'string :group 'mh-folder-selection - :package-version '(MH-E "7.2")) + :package-version '(MH-E . "7.2")) ;;; Identities (:group 'mh-identity) @@ -1391,7 +1411,7 @@ for more information." Real definition will take effect when mh-identity is loaded." nil))) -(mh-defcustom mh-identity-list nil +(defcustom-mh mh-identity-list nil "*List of identities. To customize this option, click on the \"INS\" button and enter a label @@ -1458,9 +1478,9 @@ fashion." (set-default symbol value) (mh-identity-make-menu-no-autoload)) :group 'mh-identity - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defcustom mh-auto-fields-list nil +(defcustom-mh mh-auto-fields-list nil "List of recipients for which header lines are automatically inserted. This option can be used to set the identity depending on the @@ -1519,16 +1539,16 @@ as the result is undefined." (string :tag "Field") (string :tag "Value")))))) :group 'mh-identity - :package-version '(MH-E "7.3")) + :package-version '(MH-E . "7.3")) -(mh-defcustom mh-auto-fields-prompt-flag t +(defcustom-mh mh-auto-fields-prompt-flag t "*Non-nil means to prompt before sending if fields inserted. See `mh-auto-fields-list'." :type 'boolean :group 'mh-identity - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-identity-default nil +(defcustom-mh mh-identity-default nil "Default identity to use when `mh-letter-mode' is called. See `mh-identity-list'." :type (append @@ -1537,9 +1557,9 @@ See `mh-identity-list'." (mapcar (function (lambda (arg) `(const ,arg))) (mapcar 'car mh-identity-list)))) :group 'mh-identity - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defcustom mh-identity-handlers +(defcustom-mh mh-identity-handlers '(("From" . mh-identity-handler-top) (":default" . mh-identity-handler-bottom) (":attribution-verb" . mh-identity-handler-attribution-verb) @@ -1571,11 +1591,11 @@ fields (for example, \":signature\"), and the ACTION 'remove or containing the VALUE for the field is given." :type '(repeat (cons (string :tag "Field") function)) :group 'mh-identity - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) ;;; Incorporating Your Mail (:group 'mh-inc) -(mh-defcustom mh-inc-prog "inc" +(defcustom-mh mh-inc-prog "inc" "*Program to incorporate new mail into a folder. This program generates a one-line summary for each of the new @@ -1585,7 +1605,7 @@ to be in the `mh-progs' directory. You may also link a file to several scan line format variables appropriately." :type 'string :group 'mh-inc - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) (eval-and-compile (unless (fboundp 'mh-inc-spool-make-no-autoload) @@ -1594,7 +1614,7 @@ several scan line format variables appropriately." Real definition will take effect when mh-inc is loaded." nil))) -(mh-defcustom mh-inc-spool-list nil +(defcustom-mh mh-inc-spool-list nil "*Alternate spool files. You can use the `mh-inc-spool-list' variable to direct MH-E to @@ -1635,7 +1655,7 @@ fashion." (set-default symbol value) (mh-inc-spool-make-no-autoload)) :group 'mh-inc - :package-version '(MH-E "7.3")) + :package-version '(MH-E . "7.3")) ;;; Dealing with Junk Mail (:group 'mh-junk) @@ -1667,7 +1687,7 @@ The function is always called with SYMBOL bound to until (executable-find (symbol-name (car element))) finally return (car element))))) -(mh-defcustom mh-junk-background nil +(defcustom-mh mh-junk-background nil "If on, spam programs are run in background. By default, the programs are run in the foreground, but this can @@ -1677,16 +1697,16 @@ you might try turning on this option." :type '(choice (const :tag "Off" nil) (const :tag "On" 0)) :group 'mh-junk - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-junk-disposition nil +(defcustom-mh mh-junk-disposition nil "Disposition of junk mail." :type '(choice (const :tag "Delete Spam" nil) (string :tag "Spam Folder")) :group 'mh-junk - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-junk-program nil +(defcustom-mh mh-junk-program nil "Spam program that MH-E should use. The default setting of this option is \"Auto-detect\" which means @@ -1700,11 +1720,11 @@ bogofilter, then you can set this option to \"Bogofilter\"." (const :tag "SpamProbe" spamprobe)) :set 'mh-junk-choose :group 'mh-junk - :package-version '(MH-E "7.3")) + :package-version '(MH-E . "7.3")) ;;; Editing a Draft (:group 'mh-letter) -(mh-defcustom mh-compose-insertion (if (locate-library "mml") 'mml 'mh) +(defcustom-mh mh-compose-insertion (if (locate-library "mml") 'mml 'mh) "Type of tags used when composing MIME messages. In addition to MH-style directives, MH-E also supports MML (MIME @@ -1716,23 +1736,23 @@ MH-style directives are preferred." :type '(choice (const :tag "MML" mml) (const :tag "MH" mh)) :group 'mh-letter - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-compose-skipped-header-fields +(defcustom-mh mh-compose-skipped-header-fields '("From" "Organization" "References" "In-Reply-To" "X-Face" "Face" "X-Image-URL" "X-Mailer") "List of header fields to skip over when navigating in draft." :type '(repeat (string :tag "Field")) :group 'mh-letter - :package-version '(MH-E "7.4")) + :package-version '(MH-E . "7.4")) -(mh-defcustom mh-compose-space-does-completion-flag nil +(defcustom-mh mh-compose-space-does-completion-flag nil "*Non-nil means \\<mh-letter-mode-map>\\[mh-letter-complete-or-space] does completion in message header." :type 'boolean :group 'mh-letter - :package-version '(MH-E "7.4")) + :package-version '(MH-E . "7.4")) -(mh-defcustom mh-delete-yanked-msg-window-flag nil +(defcustom-mh mh-delete-yanked-msg-window-flag nil "*Non-nil means delete any window displaying the message. This deletes the window containing the original message after @@ -1740,9 +1760,9 @@ yanking it with \\<mh-letter-mode-map>\\[mh-yank-cur-msg] to make more room on your screen for your reply." :type 'boolean :group 'mh-letter - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-extract-from-attribution-verb "wrote:" +(defcustom-mh mh-extract-from-attribution-verb "wrote:" "*Verb to use for attribution when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. The attribution consists of the sender's name and email address @@ -1754,9 +1774,9 @@ followed by the content of this option. This option can be set to (const "schrieb:") (string :tag "Custom String")) :group 'mh-letter - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-ins-buf-prefix "> " +(defcustom-mh mh-ins-buf-prefix "> " "*String to put before each line of a yanked or inserted message. The prefix \"> \" is the default setting of this option. I @@ -1770,9 +1790,9 @@ flavors of `mh-yank-behavior' or you have added a `mail-citation-hook'." :type 'string :group 'mh-letter - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-letter-complete-function 'ispell-complete-word +(defcustom-mh mh-letter-complete-function 'ispell-complete-word "*Function to call when completing outside of address or folder fields. In the body of the message, @@ -1780,18 +1800,18 @@ In the body of the message, which is set to \"ispell-complete-word\" by default." :type '(choice function (const nil)) :group 'mh-letter - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defcustom mh-letter-fill-column 72 +(defcustom-mh mh-letter-fill-column 72 "*Fill column to use in MH Letter mode. By default, this option is 72 to allow others to quote your message without line wrapping." :type 'integer :group 'mh-letter - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none") +(defcustom-mh mh-mml-method-default (if mh-pgp-support-flag "pgpmime" "none") "Default method to use in security tags. This option is used to select between a variety of mail security @@ -1812,9 +1832,9 @@ you write!" (const :tag "S/MIME" "smime") (const :tag "None" "none")) :group 'mh-letter - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-signature-file-name "~/.signature" +(defcustom-mh mh-signature-file-name "~/.signature" "*Source of user's signature. By default, the text of your signature is taken from the file @@ -1835,9 +1855,9 @@ The signature is inserted into your message with the command `mh-identity-list'." :type 'file :group 'mh-letter - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-signature-separator-flag t +(defcustom-mh mh-signature-separator-flag t "*Non-nil means a signature separator should be inserted. It is not recommended that you change this option since various @@ -1846,9 +1866,9 @@ the signature differently, and to suppress the signature when replying or yanking a letter into a draft." :type 'boolean :group 'mh-letter - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-x-face-file "~/.face" +(defcustom-mh mh-x-face-file "~/.face" "*File containing face header field to insert in outgoing mail. If the file starts with either of the strings \"X-Face:\", \"Face:\" @@ -1875,9 +1895,9 @@ To prevent the setting of any of these header fields, either set this option doesn't exist." :type 'file :group 'mh-letter - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-yank-behavior 'attribution +(defcustom-mh mh-yank-behavior 'attribution "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. To include the entire message, including the entire header, use @@ -1920,11 +1940,11 @@ inserted." (const :tag "Body With Attribution, Automatically" autoattrib)) :group 'mh-letter - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) ;;; Ranges (:group 'mh-ranges) -(mh-defcustom mh-interpret-number-as-range-flag t +(defcustom-mh mh-interpret-number-as-range-flag t "*Non-nil means interpret a number as a range. Since one of the most frequent ranges used is \"last:N\", MH-E @@ -1933,7 +1953,7 @@ option is on (which is the default). If you need to scan just the message 200, then use the range \"200:200\"." :type 'boolean :group 'mh-ranges - :package-version '(MH-E "7.4")) + :package-version '(MH-E . "7.4")) ;;; Scan Line Formats (:group 'mh-scan-line-formats) @@ -1944,7 +1964,7 @@ message 200, then use the range \"200:200\"." Real definition, below, uses variables that aren't defined yet." (set-default symbol value)))) -(mh-defcustom mh-adaptive-cmd-note-flag t +(defcustom-mh mh-adaptive-cmd-note-flag t "*Non-nil means that the message number width is determined dynamically. If you've created your own format to handle long message numbers, @@ -1960,7 +1980,7 @@ you would use \"(mh-set-cmd-note 4)\"." :type 'boolean :group 'mh-scan-line-formats :set 'mh-adaptive-cmd-note-flag-check - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) (defun mh-scan-format-file-check (symbol value) "Check if desired setting is legal. @@ -1973,7 +1993,7 @@ set SYMBOL to VALUE." "unless you use \"Use MH-E scan Format\"") (set-default symbol value))) -(mh-defcustom mh-scan-format-file t +(defcustom-mh mh-scan-format-file t "Specifies the format file to pass to the scan program. The default setting for this option is \"Use MH-E scan Format\". This @@ -1999,7 +2019,7 @@ Emacs start with 0)." (file :tag "Specify a scan Format File")) :group 'mh-scan-line-formats :set 'mh-scan-format-file-check - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) (defun mh-adaptive-cmd-note-flag-check (symbol value) "Check if desired setting is legal. @@ -2012,7 +2032,7 @@ Otherwise, set SYMBOL to VALUE." "is set to \"Use MH-E scan Format\"") (set-default symbol value))) -(mh-defcustom mh-scan-prog "scan" +(defcustom-mh mh-scan-prog "scan" "*Program used to scan messages. The name of the program that generates a listing of one line per @@ -2022,12 +2042,12 @@ directory. You may link another program to `scan' (see \"mh-profile(5)\") to produce a different type of listing." :type 'string :group 'mh-scan-line-formats - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) (make-variable-buffer-local 'mh-scan-prog) ;;; Searching (:group 'mh-search) -(mh-defcustom mh-search-program nil +(defcustom-mh mh-search-program nil "Search program that MH-E shall use. The default setting of this option is \"Auto-detect\" which means @@ -2046,11 +2066,11 @@ MH-E can be found in the documentation of `mh-search'." (const :tag "pick" pick) (const :tag "grep" grep)) :group 'mh-search - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) ;;; Sending Mail (:group 'mh-sending-mail) -(mh-defcustom mh-compose-forward-as-mime-flag t +(defcustom-mh mh-compose-forward-as-mime-flag t "*Non-nil means that messages are forwarded as attachments. By default, this option is on which means that the forwarded @@ -2064,9 +2084,9 @@ forwarded messages will always be included as attachments regardless of the settings of this option." :type 'boolean :group 'mh-sending-mail - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-compose-letter-function nil +(defcustom-mh mh-compose-letter-function nil "Invoked when starting a new draft. However, it is the last function called before you edit your @@ -2076,15 +2096,15 @@ three arguments: the contents of the TO, SUBJECT, and CC header fields." :type '(choice (const nil) function) :group 'mh-sending-mail - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-compose-prompt-flag nil +(defcustom-mh mh-compose-prompt-flag nil "*Non-nil means prompt for header fields when composing a new draft." :type 'boolean :group 'mh-sending-mail - :package-version '(MH-E "7.4")) + :package-version '(MH-E . "7.4")) -(mh-defcustom mh-forward-subject-format "%s: %s" +(defcustom-mh mh-forward-subject-format "%s: %s" "*Format string for forwarded message subject. This option is a string which includes two escapes (\"%s\"). The @@ -2092,9 +2112,9 @@ first \"%s\" is replaced with the sender of the original message, and the second one is replaced with the original \"Subject:\"." :type 'string :group 'mh-sending-mail - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-insert-x-mailer-flag t +(defcustom-mh mh-insert-x-mailer-flag t "*Non-nil means append an \"X-Mailer:\" header field to the header. This header field includes the version of MH-E and Emacs that you @@ -2102,9 +2122,9 @@ are using. If you don't want to participate in our marketing, you can turn this option off." :type 'boolean :group 'mh-sending-mail - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-redist-full-contents-flag nil +(defcustom-mh mh-redist-full-contents-flag nil "*Non-nil means the \"dist\" command needs entire letter for redistribution. This option must be turned on if \"dist\" requires the whole @@ -2114,9 +2134,9 @@ find that MH will not allow you to redistribute a message that has been redistributed before, turn off this option." :type 'boolean :group 'mh-sending-mail - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-reply-default-reply-to nil +(defcustom-mh mh-reply-default-reply-to nil "*Sets the person or persons to whom a reply will be sent. This option is set to \"Prompt\" by default so that you are @@ -2130,9 +2150,9 @@ this option to \"cc\". Other choices include \"from\", \"to\", or (const "cc") (const "all")) :group 'mh-sending-mail - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-reply-show-message-flag t +(defcustom-mh mh-reply-show-message-flag t "*Non-nil means the MH-Show buffer is displayed when replying. If you include the message automatically, you can hide the @@ -2141,7 +2161,7 @@ MH-Show buffer by turning off this option. See also `mh-reply'." :type 'boolean :group 'mh-sending-mail - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) ;;; Sequences (:group 'mh-sequences) @@ -2149,7 +2169,7 @@ See also `mh-reply'." ;; the docstring: "Additional sequences that should not to be preserved can be ;; specified by setting `mh-unpropagated-sequences' appropriately." XXX -(mh-defcustom mh-refile-preserves-sequences-flag t +(defcustom-mh mh-refile-preserves-sequences-flag t "*Non-nil means that sequences are preserved when messages are refiled. If a message is in any sequence (except \"Previous-Sequence:\" @@ -2158,9 +2178,9 @@ sequences in the destination folder. If this behavior is not desired, then turn off this option." :type 'boolean :group 'mh-sequences - :package-version '(MH-E "7.4")) + :package-version '(MH-E . "7.4")) -(mh-defcustom mh-tick-seq 'tick +(defcustom-mh mh-tick-seq 'tick "The name of the MH sequence for ticked messages. You can customize this option if you already use the \"tick\" @@ -2170,9 +2190,9 @@ there isn't much advantage to that." :type '(choice (const :tag "Disable Ticking" nil) symbol) :group 'mh-sequences - :package-version '(MH-E "7.3")) + :package-version '(MH-E . "7.3")) -(mh-defcustom mh-update-sequences-after-mh-show-flag t +(defcustom-mh mh-update-sequences-after-mh-show-flag t "*Non-nil means flush MH sequences to disk after message is shown\\<mh-folder-mode-map>. Three sequences are maintained internally by MH-E and pushed out @@ -2185,11 +2205,11 @@ this option. You can then update the state manually with the commands." :type 'boolean :group 'mh-sequences - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) ;;; Reading Your Mail (:group 'mh-show) -(mh-defcustom mh-bury-show-buffer-flag t +(defcustom-mh mh-bury-show-buffer-flag t "*Non-nil means show buffer is buried. One advantage of not burying the show buffer is that one can @@ -2198,18 +2218,18 @@ because of its proximity to its associated MH-Folder buffer. Try running \\[electric-buffer-list] to see what I mean." :type 'boolean :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-clean-message-header-flag t +(defcustom-mh mh-clean-message-header-flag t "*Non-nil means remove extraneous header fields. See also `mh-invisible-header-fields-default' and `mh-invisible-header-fields'." :type 'boolean :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-decode-mime-flag (not (not (locate-library "mm-decode"))) +(defcustom-mh mh-decode-mime-flag (not (not (locate-library "mm-decode"))) "*Non-nil means attachments are handled\\<mh-folder-mode-map>. MH-E can handle attachments as well if the Gnus `mm-decode' @@ -2225,9 +2245,9 @@ messages and other graphical widgets. See the options `mh-graphical-smileys-flag' and `mh-graphical-emphasis-flag'." :type 'boolean :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-display-buttons-for-alternatives-flag nil +(defcustom-mh mh-display-buttons-for-alternatives-flag nil "*Non-nil means display buttons for all alternative attachments. Sometimes, a mail program will produce multiple alternatives of @@ -2237,9 +2257,9 @@ displayed. If this option is on, then the preferred part is shown inline and buttons are shown for each of the other alternatives." :type 'boolean :group 'mh-show - :package-version '(MH-E "7.4")) + :package-version '(MH-E . "7.4")) -(mh-defcustom mh-display-buttons-for-inline-parts-flag nil +(defcustom-mh mh-display-buttons-for-inline-parts-flag nil "*Non-nil means display buttons for all inline attachments\\<mh-folder-mode-map>. The sender can request that attachments should be viewed inline so @@ -2260,9 +2280,9 @@ MH-E cannot display all attachments inline however. It can display text (including HTML) and images." :type 'boolean :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-do-not-confirm-flag nil +(defcustom-mh mh-do-not-confirm-flag nil "*Non-nil means non-reversible commands do not prompt for confirmation. Commands such as `mh-pack-folder' prompt to confirm whether to @@ -2272,9 +2292,9 @@ performed--which is usually desired but cannot be retracted--without question." :type 'boolean :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-fetch-x-image-url nil +(defcustom-mh mh-fetch-x-image-url nil "*Control fetching of \"X-Image-URL:\" header field image. Ths option controls the fetching of the \"X-Image-URL:\" header @@ -2308,9 +2328,9 @@ turned on." :type '(choice (const :tag "Ask Before Fetching" ask) (const :tag "Never Fetch" nil)) :group 'mh-show - :package-version '(MH-E "7.3")) + :package-version '(MH-E . "7.3")) -(mh-defcustom mh-graphical-smileys-flag t +(defcustom-mh mh-graphical-smileys-flag t "*Non-nil means graphical smileys are displayed. It is a long standing custom to inject body language using a @@ -2323,9 +2343,9 @@ This option is disabled if the option `mh-decode-mime-flag' is turned off." :type 'boolean :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-graphical-emphasis-flag t +(defcustom-mh mh-graphical-emphasis-flag t "*Non-nil means graphical emphasis is displayed. A few typesetting features are indicated in ASCII text with @@ -2340,9 +2360,9 @@ This option is disabled if the option `mh-decode-mime-flag' is turned off." :type 'boolean :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-highlight-citation-style 'gnus +(defcustom-mh mh-highlight-citation-style 'gnus "Style for highlighting citations. If the sender of the message has cited other messages in his @@ -2356,7 +2376,7 @@ of citations entirely, choose \"None\"." (const :tag "Monochrome" font-lock) (const :tag "None" nil)) :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) ;; Keep fields alphabetized. Mention source, if known. (defvar mh-invisible-header-fields-internal @@ -2569,7 +2589,7 @@ Because the function `mh-invisible-headers' uses both `mh-invisible-header-fields' and `mh-invisible-header-fields', it cannot be run until both variables have been initialized.") -(mh-defcustom mh-invisible-header-fields nil +(defcustom-mh mh-invisible-header-fields nil "*Additional header fields to hide. Header fields that you would like to hide that aren't listed in @@ -2588,9 +2608,9 @@ See also `mh-clean-message-header-flag'." (set-default symbol value) (mh-invisible-headers)) :group 'mh-show - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) -(mh-defcustom mh-invisible-header-fields-default nil +(defcustom-mh mh-invisible-header-fields-default nil "*List of hidden header fields. The header fields listed in this option are hidden, although you @@ -2606,7 +2626,7 @@ See also `mh-clean-message-header-flag'." (set-default symbol value) (mh-invisible-headers)) :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) (defvar mh-invisible-header-fields-compiled nil "*Regexp matching lines in a message header that are not to be shown. @@ -2643,7 +2663,7 @@ removed and entries from `mh-invisible-header-fields' are added." ;; Compile invisible header fields. (mh-invisible-headers) -(mh-defcustom mh-lpr-command-format "lpr -J '%s'" +(defcustom-mh mh-lpr-command-format "lpr -J '%s'" "*Command used to print\\<mh-folder-mode-map>. This option contains the Unix command line which performs the @@ -2658,9 +2678,9 @@ This options is not used by the commands \\[mh-ps-print-msg] or \\[mh-ps-print-msg-file]." :type 'string :group 'mh-show - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-max-inline-image-height nil +(defcustom-mh mh-max-inline-image-height nil "*Maximum inline image height if \"Content-Disposition:\" is not present. Some older mail programs do not insert this needed plumbing to @@ -2674,9 +2694,9 @@ a large number. The size of your screen is a good choice for these numbers." :type '(choice (const nil) integer) :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-max-inline-image-width nil +(defcustom-mh mh-max-inline-image-width nil "*Maximum inline image width if \"Content-Disposition:\" is not present. Some older mail programs do not insert this needed plumbing to @@ -2690,9 +2710,9 @@ a large number. The size of your screen is a good choice for these numbers." :type '(choice (const nil) integer) :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-mhl-format-file nil +(defcustom-mh mh-mhl-format-file nil "*Specifies the format file to pass to the \"mhl\" program. Normally MH-E takes care of displaying messages itself (rather than @@ -2714,9 +2734,9 @@ file." (const :tag "Use Default mhl Format" t) (file :tag "Specify an mhl Format File")) :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-mime-save-parts-default-directory t +(defcustom-mh mh-mime-save-parts-default-directory t "Default directory to use for \\<mh-folder-mode-map>\\[mh-mime-save-parts]. The default value for this option is \"Prompt Always\" so that @@ -2730,9 +2750,9 @@ directory's name." (const :tag "Prompt Always" t) directory) :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-print-background-flag nil +(defcustom-mh mh-print-background-flag nil "*Non-nil means messages should be printed in the background\\<mh-folder-mode-map>. Normally messages are printed in the foreground. If this is slow on @@ -2746,9 +2766,9 @@ This option is not used by the commands \\[mh-ps-print-msg] or \\[mh-ps-print-msg-file]." :type 'boolean :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-show-maximum-size 0 +(defcustom-mh mh-show-maximum-size 0 "*Maximum size of message (in bytes) to display automatically. This option provides an opportunity to skip over large messages @@ -2756,9 +2776,9 @@ which may be slow to load. The default value of 0 means that all message are shown regardless of size." :type 'integer :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-show-use-xface-flag (>= emacs-major-version 21) +(defcustom-mh mh-show-use-xface-flag (>= emacs-major-version 21) "*Non-nil means display face images in MH-show buffers. MH-E can display the content of \"Face:\", \"X-Face:\", and @@ -2796,9 +2816,9 @@ The option `mh-fetch-x-image-url' controls the fetching of the \"X-Image-URL:\" header field image." :type 'boolean :group 'mh-show - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-store-default-directory nil +(defcustom-mh mh-store-default-directory nil "*Default directory for \\<mh-folder-mode-map>\\[mh-store-msg]. If you would like to change the initial default directory, @@ -2808,9 +2828,9 @@ the content of these messages." :type '(choice (const :tag "Current" nil) directory) :group 'mh-show - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-summary-height nil +(defcustom-mh mh-summary-height nil "*Number of lines in MH-Folder buffer (including the mode line). The default value of this option is \"Automatic\" which means @@ -2821,20 +2841,20 @@ lines you'd like to see." :type '(choice (const :tag "Automatic" nil) (integer :tag "Fixed Size")) :group 'mh-show - :package-version '(MH-E "7.4")) + :package-version '(MH-E . "7.4")) ;;; The Speedbar (:group 'mh-speedbar) -(mh-defcustom mh-speed-update-interval 60 +(defcustom-mh mh-speed-update-interval 60 "Time between speedbar updates in seconds. Set to 0 to disable automatic update." :type 'integer :group 'mh-speedbar - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) ;;; Threading (:group 'mh-thread) -(mh-defcustom mh-show-threads-flag nil +(defcustom-mh mh-show-threads-flag nil "*Non-nil means new folders start in threaded mode. Threading large number of messages can be time consuming so this @@ -2843,14 +2863,14 @@ threading will be done only if the number of messages being threaded is less than `mh-large-folder'." :type 'boolean :group 'mh-thread - :package-version '(MH-E "7.1")) + :package-version '(MH-E . "7.1")) ;;; The Tool Bar (:group 'mh-tool-bar) ;; mh-tool-bar-folder-buttons and mh-tool-bar-letter-buttons defined ;; dynamically in mh-tool-bar.el. -(mh-defcustom mh-tool-bar-search-function 'mh-search +(defcustom-mh mh-tool-bar-search-function 'mh-search "*Function called by the tool bar search button. By default, this is set to `mh-search'. You can also choose @@ -2859,11 +2879,11 @@ of your own choosing." :type '(choice (const mh-search) (function :tag "Other Function")) :group 'mh-tool-bar - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) ;; XEmacs has a couple of extra customizations... (mh-do-in-xemacs - (mh-defcustom mh-xemacs-use-tool-bar-flag mh-xemacs-has-tool-bar-flag + (defcustom-mh mh-xemacs-use-tool-bar-flag mh-xemacs-has-tool-bar-flag "*If non-nil, use tool bar. This option controls whether to show the MH-E icons at all. By @@ -2877,9 +2897,9 @@ won't be able to turn on this option." (not mh-xemacs-has-tool-bar-flag)) (error "Tool bar not supported")) (set-default symbol value)) - :package-version '(MH-E "7.3")) + :package-version '(MH-E . "7.3")) - (mh-defcustom mh-xemacs-tool-bar-position nil + (defcustom-mh mh-xemacs-tool-bar-position nil "*Tool bar location. This option controls the placement of the tool bar along the four @@ -2895,13 +2915,13 @@ default tool bar." (const :tag "Left" :value left) (const :tag "Right" :value right)) :group 'mh-tool-bar - :package-version '(MH-E "7.3"))) + :package-version '(MH-E . "7.3"))) ;;; Hooks (:group 'mh-hooks + group where hook described) -(mh-defcustom mh-after-commands-processed-hook nil +(defcustom-mh mh-after-commands-processed-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] after performing outstanding refile and delete requests. Variables that are useful in this hook include @@ -2911,16 +2931,16 @@ folder, which is also available in `mh-current-folder'." :type 'hook :group 'mh-hooks :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-alias-reloaded-hook nil +(defcustom-mh mh-alias-reloaded-hook nil "Hook run by `mh-alias-reload' after loading aliases." :type 'hook :group 'mh-hooks :group 'mh-alias - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-before-commands-processed-hook nil +(defcustom-mh mh-before-commands-processed-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-execute-commands] before performing outstanding refile and delete requests. Variables that are useful in this hook include `mh-delete-list' @@ -2929,9 +2949,9 @@ be made to the current folder, `mh-current-folder'." :type 'hook :group 'mh-hooks :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-before-quit-hook nil +(defcustom-mh mh-before-quit-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-quit] before quitting MH-E. This hook is called before the quit occurs, so you might use it @@ -2942,9 +2962,9 @@ See also `mh-quit-hook'." :type 'hook :group 'mh-hooks :group 'mh-folder - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-before-send-letter-hook nil +(defcustom-mh mh-before-send-letter-hook nil "Hook run at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command. For example, if you want to check your spelling in your message @@ -2953,9 +2973,9 @@ before sending, add the `ispell-message' function." :options '(ispell-message) :group 'mh-hooks :group 'mh-letter - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-delete-msg-hook nil +(defcustom-mh mh-delete-msg-hook nil "Hook run by \\<mh-letter-mode-map>\\[mh-delete-msg] after marking each message for deletion. For example, a past maintainer of MH-E used this once when he @@ -2963,9 +2983,9 @@ kept statistics on his mail usage." :type 'hook :group 'mh-hooks :group 'mh-show - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-find-path-hook nil +(defcustom-mh mh-find-path-hook nil "Hook run by `mh-find-path' after reading the user's MH profile. This hook can be used the change the value of the variables that @@ -2974,30 +2994,30 @@ between MH and MH-E." :type 'hook :group 'mh-hooks :group 'mh-e - :package-version '(MH-E "7.0")) + :package-version '(MH-E . "7.0")) -(mh-defcustom mh-folder-mode-hook nil +(defcustom-mh mh-folder-mode-hook nil "Hook run by `mh-folder-mode' when visiting a new folder." :type 'hook :group 'mh-hooks :group 'mh-folder - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-forward-hook nil +(defcustom-mh mh-forward-hook nil "Hook run by `mh-forward' on a forwarded letter." :type 'hook :group 'mh-hooks :group 'mh-sending-mail - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-inc-folder-hook nil +(defcustom-mh mh-inc-folder-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-inc-folder] after incorporating mail into a folder." :type 'hook :group 'mh-hooks :group 'mh-inc - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-insert-signature-hook nil +(defcustom-mh mh-insert-signature-hook nil "Hook run by \\<mh-letter-mode-map>\\[mh-insert-signature] after signature has been inserted. Hook functions may access the actual name of the file or the @@ -3006,9 +3026,9 @@ function used to insert the signature with :type 'hook :group 'mh-hooks :group 'mh-letter - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-kill-folder-suppress-prompt-hooks '(mh-search-p) +(defcustom-mh mh-kill-folder-suppress-prompt-hooks '(mh-search-p) "Abnormal hook run at the beginning of \\<mh-folder-mode-map>\\[mh-kill-folder]. The hook functions are called with no arguments and should return @@ -3024,9 +3044,9 @@ accident in the \"+inbox\" folder, you will not be happy." :type 'hook :group 'mh-hooks :group 'mh-folder - :package-version '(MH-E "7.4")) + :package-version '(MH-E . "7.4")) -(mh-defcustom mh-letter-mode-hook nil +(defcustom-mh mh-letter-mode-hook nil "Hook run by `mh-letter-mode' on a new letter. This hook allows you to do some processing before editing a @@ -3037,16 +3057,16 @@ go." :type 'hook :group 'mh-hooks :group 'mh-sending-mail - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-mh-to-mime-hook nil +(defcustom-mh mh-mh-to-mime-hook nil "Hook run on the formatted letter by \\<mh-letter-mode-map>\\[mh-mh-to-mime]." :type 'hook :group 'mh-hooks :group 'mh-letter - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-search-mode-hook nil +(defcustom-mh mh-search-mode-hook nil "Hook run upon entry to `mh-search-mode'\\<mh-folder-mode-map>. If you find that you do the same thing over and over when editing @@ -3056,9 +3076,9 @@ This can be done with this hook which is called when :type 'hook :group 'mh-hooks :group 'mh-search - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defcustom mh-quit-hook nil +(defcustom-mh mh-quit-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-quit] after quitting MH-E. This hook is not run in an MH-E context, so you might use it to @@ -3068,16 +3088,16 @@ See also `mh-before-quit-hook'." :type 'hook :group 'mh-hooks :group 'mh-folder - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-refile-msg-hook nil +(defcustom-mh mh-refile-msg-hook nil "Hook run by \\<mh-folder-mode-map>\\[mh-refile-msg] after marking each message for refiling." :type 'hook :group 'mh-hooks :group 'mh-folder - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-show-hook nil +(defcustom-mh mh-show-hook nil "Hook run after \\<mh-folder-mode-map>\\[mh-show] shows a message. It is the last thing called after messages are displayed. It's @@ -3086,9 +3106,9 @@ used to affect the behavior of MH-E in general or when :type 'hook :group 'mh-hooks :group 'mh-show - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-show-mode-hook nil +(defcustom-mh mh-show-mode-hook nil "Hook run upon entry to `mh-show-mode'. This hook is called early on in the process of the message @@ -3097,9 +3117,9 @@ message's content. See `mh-show-hook'." :type 'hook :group 'mh-hooks :group 'mh-show - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) -(mh-defcustom mh-unseen-updated-hook nil +(defcustom-mh mh-unseen-updated-hook nil "Hook run after the unseen sequence has been updated. The variable `mh-seen-list' can be used by this hook to obtain @@ -3108,7 +3128,7 @@ sequence." :type 'hook :group 'mh-hooks :group 'mh-sequences - :package-version '(MH-E "6.0")) + :package-version '(MH-E . "6.0")) @@ -3119,7 +3139,7 @@ sequence." ;; To add a new face: ;; 1. Add entry to variable mh-face-data. -;; 2. Create face using mh-defface (which removes min-color spec and +;; 2. Create face using defface-mh (which removes min-color spec and ;; :package-version keyword where these are not supported), ;; accessing face data with function mh-face-data. ;; 3. Add inherit argument to function mh-face-data if applicable. @@ -3268,7 +3288,7 @@ sequence." (:underline t))))) "MH-E face data. Used by function `mh-face-data' which returns spec that is -consumed by `mh-defface'.") +consumed by `defface-mh'.") (require 'cus-face) @@ -3321,14 +3341,14 @@ specified colors." (setq new-spec (cons entry new-spec))))) new-spec)))) -(mh-defface mh-folder-address +(defface-mh mh-folder-address (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) "Recipient face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-body +(defface-mh mh-folder-body (mh-face-data 'mh-folder-msg-number '((((class color)) (:inherit mh-folder-msg-number)) @@ -3337,49 +3357,49 @@ specified colors." "Body text face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-cur-msg-number +(defface-mh mh-folder-cur-msg-number (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number :bold t)))) "Current message number face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-date +(defface-mh mh-folder-date (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) "Date face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-deleted +(defface-mh mh-folder-deleted (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-msg-number)))) "Deleted message face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-followup (mh-face-data 'mh-folder-followup) +(defface-mh mh-folder-followup (mh-face-data 'mh-folder-followup) "\"Re:\" face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-msg-number (mh-face-data 'mh-folder-msg-number) +(defface-mh mh-folder-msg-number (mh-face-data 'mh-folder-msg-number) "Message number face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-refiled (mh-face-data 'mh-folder-refiled) +(defface-mh mh-folder-refiled (mh-face-data 'mh-folder-refiled) "Refiled message face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-sent-to-me-hint +(defface-mh mh-folder-sent-to-me-hint (mh-face-data 'mh-folder-msg-number '((t (:inherit mh-folder-date)))) "Fontification hint face in messages sent directly to us. The detection of messages sent to us is governed by the scan @@ -3387,9 +3407,9 @@ format `mh-scan-format-nmh' and the regular expression `mh-scan-sent-to-me-sender-regexp'." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-sent-to-me-sender +(defface-mh mh-folder-sent-to-me-sender (mh-face-data 'mh-folder-followup '((t (:inherit mh-folder-followup)))) "Sender face in messages sent directly to us. The detection of messages sent to us is governed by the scan @@ -3397,145 +3417,135 @@ format `mh-scan-format-nmh' and the regular expression `mh-scan-sent-to-me-sender-regexp'." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-subject (mh-face-data 'mh-folder-subject) +(defface-mh mh-folder-subject (mh-face-data 'mh-folder-subject) "Subject face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-tick (mh-face-data 'mh-folder-tick) +(defface-mh mh-folder-tick (mh-face-data 'mh-folder-tick) "Ticked message face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-folder-to (mh-face-data 'mh-folder-to) +(defface-mh mh-folder-to (mh-face-data 'mh-folder-to) "\"To:\" face." :group 'mh-faces :group 'mh-folder - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-letter-header-field (mh-face-data 'mh-letter-header-field) +(defface-mh mh-letter-header-field (mh-face-data 'mh-letter-header-field) "Editable header field value face in draft buffers." :group 'mh-faces :group 'mh-letter - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-search-folder (mh-face-data 'mh-search-folder) +(defface-mh mh-search-folder (mh-face-data 'mh-search-folder) "Folder heading face in MH-Folder buffers created by searches." :group 'mh-faces :group 'mh-search - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-cc (mh-face-data 'mh-show-cc) +(defface-mh mh-show-cc (mh-face-data 'mh-show-cc) "Face used to highlight \"cc:\" header fields." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-date (mh-face-data 'mh-show-date) +(defface-mh mh-show-date (mh-face-data 'mh-show-date) "Face used to highlight \"Date:\" header fields." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-from (mh-face-data 'mh-show-from) +(defface-mh mh-show-from (mh-face-data 'mh-show-from) "Face used to highlight \"From:\" header fields." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-header (mh-face-data 'mh-show-header) +(defface-mh mh-show-header (mh-face-data 'mh-show-header) "Face used to deemphasize less interesting header fields." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad) +(defface-mh mh-show-pgg-bad (mh-face-data 'mh-show-pgg-bad) "Bad PGG signature face." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-pgg-good (mh-face-data 'mh-show-pgg-good) +(defface-mh mh-show-pgg-good (mh-face-data 'mh-show-pgg-good) "Good PGG signature face." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown) +(defface-mh mh-show-pgg-unknown (mh-face-data 'mh-show-pgg-unknown) "Unknown or untrusted PGG signature face." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-signature (mh-face-data 'mh-show-signature) +(defface-mh mh-show-signature (mh-face-data 'mh-show-signature) "Signature face." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-subject +(defface-mh mh-show-subject (mh-face-data 'mh-folder-subject '((t (:inherit mh-folder-subject)))) "Face used to highlight \"Subject:\" header fields." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-to (mh-face-data 'mh-show-to) +(defface-mh mh-show-to (mh-face-data 'mh-show-to) "Face used to highlight \"To:\" header fields." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-show-xface +(defface-mh mh-show-xface (mh-face-data 'mh-show-from '((t (:inherit (mh-show-from highlight))))) "X-Face image face. The background and foreground are used in the image." :group 'mh-faces :group 'mh-show - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-speedbar-folder (mh-face-data 'mh-speedbar-folder) +(defface-mh mh-speedbar-folder (mh-face-data 'mh-speedbar-folder) "Basic folder face." :group 'mh-faces :group 'mh-speedbar - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-speedbar-folder-with-unseen-messages +(defface-mh mh-speedbar-folder-with-unseen-messages (mh-face-data 'mh-speedbar-folder '((t (:inherit mh-speedbar-folder :bold t)))) "Folder face when folder contains unread messages." :group 'mh-faces :group 'mh-speedbar - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-speedbar-selected-folder +(defface-mh mh-speedbar-selected-folder (mh-face-data 'mh-speedbar-selected-folder) "Selected folder face." :group 'mh-faces :group 'mh-speedbar - :package-version '(MH-E "8.0")) + :package-version '(MH-E . "8.0")) -(mh-defface mh-speedbar-selected-folder-with-unseen-messages +(defface-mh mh-speedbar-selected-folder-with-unseen-messages (mh-face-data 'mh-speedbar-selected-folder '((t (:inherit mh-speedbar-selected-folder :bold t)))) "Selected folder face when folder contains unread messages." :group 'mh-faces :group 'mh-speedbar - :package-version '(MH-E "8.0")) - -;; Get rid of temporary functions and data structures. -(fmakunbound 'mh-defcustom) -(fmakunbound 'mh-defface) -(fmakunbound 'mh-defgroup) -(fmakunbound 'mh-face-data) -(fmakunbound 'mh-strip-package-version) -(makunbound 'mh-face-data) -(makunbound 'mh-inherit-face-flag) -(makunbound 'mh-min-colors-defined-flag) + :package-version '(MH-E . "8.0")) (provide 'mh-e) diff --git a/lisp/mh-e/mh-folder.el b/lisp/mh-e/mh-folder.el index 8fb65051a86..8516856f14e 100644 --- a/lisp/mh-e/mh-folder.el +++ b/lisp/mh-e/mh-folder.el @@ -522,11 +522,10 @@ font-lock is done highlighting.") (add-to-list 'which-func-modes 'mh-folder-mode)) ;; Shush compiler. -(eval-when-compile - (defvar desktop-save-buffer) - (defvar font-lock-auto-fontify) - (defvar image-load-path) - (mh-do-in-xemacs (defvar font-lock-defaults))) +(defvar desktop-save-buffer) +(defvar font-lock-auto-fontify) +(defvar image-load-path) +(defvar font-lock-defaults) ; XEmacs (defvar mh-folder-buttons-init-flag nil) diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 84b04d51c35..e97533e5724 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -138,7 +138,7 @@ Display the results only if something went wrong." (display-buffer mh-temp-buffer))) ;; Shush compiler. -(eval-when-compile (defvar view-exit-action)) +(defvar view-exit-action) ;;;###mh-autoload (defun mh-list-folders () diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el index 970f98556e2..1e3b385eda7 100644 --- a/lisp/mh-e/mh-gnus.el +++ b/lisp/mh-e/mh-gnus.el @@ -39,19 +39,19 @@ (mh-require 'mml nil t) ;; Copy of function from gnus-util.el. -(mh-defun-compat mh-gnus-local-map-property gnus-local-map-property (map) +(defun-mh mh-gnus-local-map-property gnus-local-map-property (map) "Return a list suitable for a text property list specifying keymap MAP." (cond (mh-xemacs-flag (list 'keymap map)) ((>= emacs-major-version 21) (list 'keymap map)) (t (list 'local-map map)))) ;; Copy of function from mm-decode.el. -(mh-defun-compat mh-mm-merge-handles mm-merge-handles (handles1 handles2) +(defun-mh mh-mm-merge-handles mm-merge-handles (handles1 handles2) (append (if (listp (car handles1)) handles1 (list handles1)) (if (listp (car handles2)) handles2 (list handles2)))) ;; Copy of function from mm-decode.el. -(mh-defun-compat mh-mm-set-handle-multipart-parameter +(defun-mh mh-mm-set-handle-multipart-parameter mm-set-handle-multipart-parameter (handle parameter value) ;; HANDLE could be a CTL. (if handle @@ -59,7 +59,7 @@ (car handle)))) ;; Copy of function from mm-view.el. -(mh-defun-compat mh-mm-inline-text-vcard mm-inline-text-vcard (handle) +(defun-mh mh-mm-inline-text-vcard mm-inline-text-vcard (handle) (let (buffer-read-only) (mm-insert-inline handle @@ -73,17 +73,17 @@ ;; Function from mm-decode.el used in PGP messages. Just define it with older ;; Gnus to avoid compiler warning. -(mh-defun-compat mh-mm-possibly-verify-or-decrypt +(defun-mh mh-mm-possibly-verify-or-decrypt mm-possibly-verify-or-decrypt (parts ctl) nil) ;; Copy of macro in mm-decode.el. -(mh-defmacro-compat mh-mm-handle-multipart-ctl-parameter +(defmacro-mh mh-mm-handle-multipart-ctl-parameter mm-handle-multipart-ctl-parameter (handle parameter) `(get-text-property 0 ,parameter (car ,handle))) ;; Copy of function in mm-decode.el. -(mh-defun-compat mh-mm-readable-p mm-readable-p (handle) +(defun-mh mh-mm-readable-p mm-readable-p (handle) "Say whether the content of HANDLE is readable." (and (< (with-current-buffer (mm-handle-buffer handle) (buffer-size)) 10000) @@ -93,7 +93,7 @@ (not (mh-mm-long-lines-p 76)))))) ;; Copy of function in mm-bodies.el. -(mh-defun-compat mh-mm-long-lines-p mm-long-lines-p (length) +(defun-mh mh-mm-long-lines-p mm-long-lines-p (length) "Say whether any of the lines in the buffer is longer than LENGTH." (save-excursion (goto-char (point-min)) @@ -105,21 +105,21 @@ (and (> (current-column) length) (current-column)))) -(mh-defun-compat mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle) +(defun-mh mh-mm-keep-viewer-alive-p mm-keep-viewer-alive-p (handle) ;; Released Gnus doesn't keep handles associated with externally displayed ;; MIME parts. So this will always return nil. nil) -(mh-defun-compat mh-mm-destroy-parts mm-destroy-parts (list) +(defun-mh mh-mm-destroy-parts mm-destroy-parts (list) "Older versions of Emacs don't have this function." nil) -(mh-defun-compat mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles) +(defun-mh mh-mm-uu-dissect-text-parts mm-uu-dissect-text-parts (handles) "Emacs 21 and XEmacs don't have this function." nil) ;; Copy of function in mml.el. -(mh-defun-compat mh-mml-minibuffer-read-disposition +(defun-mh mh-mml-minibuffer-read-disposition mml-minibuffer-read-disposition (type &optional default) (unless default (setq default (if (and (string-match "\\`text/" type) diff --git a/lisp/mh-e/mh-letter.el b/lisp/mh-e/mh-letter.el index 024c1875eac..2da824c34c2 100644 --- a/lisp/mh-e/mh-letter.el +++ b/lisp/mh-e/mh-letter.el @@ -278,9 +278,8 @@ searching for `mh-mail-header-separator' in the buffer." (defvar mh-letter-buttons-init-flag nil) ;; Shush compiler. -(eval-when-compile - (defvar image-load-path) - (mh-do-in-xemacs (defvar font-lock-defaults))) +(defvar image-load-path) +(defvar font-lock-defaults) ; XEmacs ;; Ensure new buffers won't get this mode if default-major-mode is nil. (put 'mh-letter-mode 'mode-class 'special) diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index d35e759bcd4..c05e867a2b4 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -825,7 +825,9 @@ being used to highlight the signature in a MIME part." ;;; Button Display ;; Shush compiler. -(eval-when-compile (mh-do-in-xemacs (defvar dots) (defvar type) (defvar ov))) +(defvar dots) ; XEmacs +(defvar type) ; XEmacs +(defvar ov) ; XEmacs (defun mh-insert-mime-button (handle index displayed) "Insert MIME button for HANDLE. @@ -870,12 +872,9 @@ by commands like \"K v\" which operate on individual MIME parts." (mh-funcall-if-exists overlay-put ov 'evaporate t)))) ;; Shush compiler. -(eval-when-compile - (when (< emacs-major-version 22) - (defvar mm-verify-function-alist) - (defvar mm-decrypt-function-alist)) - (mh-do-in-xemacs - (defvar pressed-details))) +(defvar mm-verify-function-alist) ; < Emacs 22 +(defvar mm-decrypt-function-alist) ; < Emacs 22 +(defvar pressed-details) ; XEmacs (defun mh-insert-mime-security-button (handle) "Display buttons for PGP message, HANDLE." @@ -1537,7 +1536,7 @@ a prefix argument NOCONFIRM." (after-find-file nil))) ;; Shush compiler. -(eval-when-compile (defvar mh-identity-pgg-default-user-id)) +(defvar mh-identity-pgg-default-user-id) ;;;###mh-autoload (defun mh-mml-secure-message-encrypt (method) diff --git a/lisp/mh-e/mh-search.el b/lisp/mh-e/mh-search.el index 17b63c91000..14891204fad 100644 --- a/lisp/mh-e/mh-search.el +++ b/lisp/mh-e/mh-search.el @@ -324,7 +324,7 @@ folder containing the index search results." count (> (hash-table-count msg-hash) 0))))))) ;; Shush compiler. -(eval-when-compile (mh-do-in-xemacs (defvar pick-folder))) +(defvar pick-folder) ; XEmacs (defun mh-search-folder (folder window-config) "Search FOLDER for messages matching a pattern. @@ -404,10 +404,8 @@ or nothing to search all folders." (mh-index-sequenced-messages folders mh-tick-seq)) ;; Shush compiler. -(eval-when-compile - (mh-do-in-xemacs - (defvar mh-mairix-folder) - (defvar mh-flists-search-folders))) +(defvar mh-mairix-folder) ; XEmacs +(defvar mh-flists-search-folders) ; XEmacs ;;;###mh-autoload (defun mh-index-sequenced-messages (folders sequence) @@ -1414,9 +1412,7 @@ being the list of messages originally from that folder." (mh-require 'which-func nil t) ;; Shush compiler. -(eval-when-compile - (if (or mh-xemacs-flag (< emacs-major-version 22)) - (defvar which-func-mode))) +(defvar which-func-mode) ; < Emacs 22, XEmacs ;;;###mh-autoload (defun mh-index-create-imenu-index () @@ -1441,7 +1437,7 @@ being the list of messages originally from that folder." mh-index-data) ;; Shush compiler -(eval-when-compile (if mh-xemacs-flag (defvar mh-speed-flists-inhibit-flag))) +(defvar mh-speed-flists-inhibit-flag) ; XEmacs ;;;###mh-autoload (defun mh-index-execute-commands () diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index a5732d00bc6..ae260692b74 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -134,7 +134,7 @@ you want to delete the messages, use \"\\[universal-argument] (apply #'mh-speed-flists t folders-changed)))) ;; Shush compiler. -(eval-when-compile (defvar view-exit-action)) +(defvar view-exit-action) ;;;###mh-autoload (defun mh-list-sequences () @@ -202,7 +202,7 @@ MESSAGE appears." " ")))) ;; Shush compiler. -(eval-when-compile (mh-do-in-xemacs (defvar tool-bar-mode))) +(defvar tool-bar-mode) ; XEmacs ;;;###mh-autoload (defun mh-narrow-to-seq (sequence) diff --git a/lisp/mh-e/mh-show.el b/lisp/mh-e/mh-show.el index d7b656d3462..fb6698467da 100644 --- a/lisp/mh-e/mh-show.el +++ b/lisp/mh-e/mh-show.el @@ -815,7 +815,7 @@ operation." (put 'mh-show-mode 'mode-class 'special) ;; Shush compiler. -(eval-when-compile (defvar font-lock-auto-fontify)) +(defvar font-lock-auto-fontify) ;;;###mh-autoload (define-derived-mode mh-show-mode text-mode "MH-Show" diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index e41ee0bcc4f..73a15583165 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -556,10 +556,18 @@ nested folders within them." sub-folders) sub-folders))) +;; FIXME: This function does not do well if FOLDER does not exist. It +;; then changes the context to that folder which causes problems down +;; the line. Since a folder in the cache could later be deleted, it +;; would be good for mh-sub-folders-actual to return nil in this case +;; so that mh-sub-folders could delete it from the cache. This +;; function could protect itself by using a temporary context. (defun mh-sub-folders-actual (folder) "Execute the command folders to return the sub-folders of FOLDER. Filters out the folder names that start with \".\" so that -directories that aren't usually mail folders are hidden." +directories that aren't usually mail folders are hidden. +Expects FOLDER to have already been normalized with + (mh-normalize-folder-name folder nil nil t)" (let ((arg-list `(,(expand-file-name "folders" mh-progs) nil (t nil) nil "-noheader" "-norecurse" "-nototal" ,@(if (stringp folder) (list folder) ()))) @@ -657,7 +665,7 @@ See `expand-file-name' for description of DEFAULT." (defvar mh-folder-hist nil) ;; Shush compiler. -(eval-when-compile (defvar mh-speed-flists-cache)) +(defvar mh-speed-flists-cache) (defvar mh-allow-root-folder-flag nil "Non-nil means \"+\" is an acceptable folder name. @@ -683,53 +691,58 @@ This variable should never be set.") (defun mh-folder-completion-function (name predicate flag) "Programmable completion for folder names. NAME is the partial folder name that has been input. PREDICATE if -non-nil is a function that is used to filter the possible choices -and FLAG determines whether the completion is over." +non-nil is a function that is used to filter the possible +choices. FLAG is nil to indicate `try-completion', t for +`all-completions', or the symbol lambda for `test-completion'. +See Info node `(elisp) Programmed Completion' for details." (let* ((orig-name name) + ;; After normalization, name is nil, +, or +something. If a + ;; trailing slash is present, it is preserved. (name (mh-normalize-folder-name name nil t)) (last-slash (mh-search-from-end ?/ name)) - (last-complete (if last-slash (substring name 0 last-slash) nil)) + ;; nil if + or +folder; +folder/ if slash present. + (last-complete (if last-slash (substring name 0 (1+ last-slash)) nil)) + ;; Either +folder/remainder, +remainder, or "". (remainder (cond (last-complete (substring name (1+ last-slash))) - ((and (> (length name) 0) (equal (aref name 0) ?+)) - (substring name 1)) + (name (substring name 1)) (t "")))) (cond ((eq flag nil) - (let ((try-res (try-completion - name - (mapcar (lambda (x) - (cons (if (not last-complete) - (concat "+" (car x)) - (concat last-complete "/" (car x))) - (cdr x))) - (mh-sub-folders last-complete t)) - predicate))) + (let ((try-res + (try-completion + name + (mapcar (lambda (x) + (cons (concat (or last-complete "+") (car x)) + (cdr x))) + (mh-sub-folders last-complete t)) + predicate))) (cond ((eq try-res nil) nil) ((and (eq try-res t) (equal name orig-name)) t) ((eq try-res t) name) (t try-res)))) ((eq flag t) - (all-completions - remainder (mh-sub-folders last-complete t) predicate)) + (mapcar (lambda (x) + (concat (or last-complete "+") x)) + (all-completions + remainder (mh-sub-folders last-complete t) predicate))) ((eq flag 'lambda) - (let ((path (concat mh-user-path - (substring (mh-normalize-folder-name name) 1)))) + (let ((path (concat (unless (and (> (length name) 1) + (eq (aref name 1) ?/)) + mh-user-path) + (substring name 1)))) (cond (mh-allow-root-folder-flag (file-exists-p path)) ((equal path mh-user-path) nil) (t (file-exists-p path)))))))) ;; Shush compiler. -(eval-when-compile - (mh-do-in-xemacs - (defvar completion-root-regexp) - (defvar minibuffer-completing-file-name))) +(defvar completion-root-regexp) ; XEmacs +(defvar minibuffer-completing-file-name) ; XEmacs (defun mh-folder-completing-read (prompt default allow-root-folder-flag) "Read folder name with PROMPT and default result DEFAULT. If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be a folder name corresponding to `mh-user-path'." (mh-normalize-folder-name - (let ((minibuffer-completing-file-name t) - (completion-root-regexp "^[+/]") + (let ((completion-root-regexp "^[+/]") (minibuffer-local-completion-map mh-folder-completion-map) (mh-allow-root-folder-flag allow-root-folder-flag)) (completing-read prompt 'mh-folder-completion-function nil nil nil diff --git a/lisp/mh-e/mh-xface.el b/lisp/mh-e/mh-xface.el index 58d175f5470..deb2cebad14 100644 --- a/lisp/mh-e/mh-xface.el +++ b/lisp/mh-e/mh-xface.el @@ -60,8 +60,7 @@ (funcall mh-show-xface-function))) ;; Shush compiler. -(eval-when-compile - (mh-do-in-xemacs (defvar default-enable-multibyte-characters))) +(defvar default-enable-multibyte-characters) ; XEmacs (defun mh-face-display-function () "Display a Face, X-Face, or X-Image-URL header field. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 04fbd3636f8..34bb388f855 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -979,7 +979,7 @@ Returns nil if an error message has appeared." ;; Algorithm: get waiting output. See if last line contains ;; tramp-smb-prompt sentinel or tramp-smb-errors strings. ;; If not, wait a bit and again get waiting output. - (while (and (not found) (not err)) + (while (not found) ;; Accept pending output. (tramp-accept-process-output proc) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 58f74133cd5..617e21ebfeb 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -3584,6 +3584,10 @@ the result will be a local, non-Tramp, filename." "Global variable keeping asynchronous process object. Used in `tramp-handle-shell-command'") +(defvar tramp-display-shell-command-buffer t + "Whether to display output buffer of `shell-command'. +This is necessary for handling DISPLAY of `process-file'.") + (defun tramp-handle-shell-command (command &optional output-buffer error-buffer) "Like `shell-command' for tramp files. This will break if COMMAND prints a newline, followed by the value of @@ -3692,7 +3696,8 @@ This will break if COMMAND prints a newline, followed by the value of (skip-chars-forward "^ ") (setq status (read (current-buffer))))) (unless (zerop (buffer-size)) - (display-buffer output-buffer)) + (when tramp-display-shell-command-buffer + (display-buffer output-buffer))) status)) ;; The following is only executed if something strange was ;; happening. Emit a helpful message and do it anyway. @@ -3707,11 +3712,10 @@ This will break if COMMAND prints a newline, followed by the value of (when (and (numberp buffer) (zerop buffer)) (error "Implementation does not handle immediate return")) (when (consp buffer) (error "Implementation does not handle error files")) - (shell-command - (mapconcat 'tramp-shell-quote-argument - (cons program args) - " ") - buffer)) + (let ((tramp-display-shell-command-buffer display)) + (shell-command + (mapconcat 'tramp-shell-quote-argument (cons program args) " ") + buffer))) ;; File Editing. @@ -4454,24 +4458,28 @@ necessary anymore." file) (member (match-string 1 file) (mapcar 'car tramp-methods))) ((or (equal last-input-event 'tab) - ;; Emacs - (and (integerp last-input-event) - (not (event-modifiers last-input-event)) - (or (char-equal last-input-event ?\?) - (char-equal last-input-event ?\t) ; handled by 'tab already? - (char-equal last-input-event ?\ ))) + ;; Emacs + (and (integerp last-input-event) + (or + ;; ?\t has event-modifier 'control + (char-equal last-input-event ?\t) + (and (not (event-modifiers last-input-event)) + (or (char-equal last-input-event ?\?) + (char-equal last-input-event ?\ ))))) ;; XEmacs (and (featurep 'xemacs) - (not (event-modifiers last-input-event)) - (or (char-equal - (funcall (symbol-function 'event-to-character) - last-input-event) ?\?) - (char-equal - (funcall (symbol-function 'event-to-character) - last-input-event) ?\t) - (char-equal - (funcall (symbol-function 'event-to-character) - last-input-event) ?\ )))) + (or + ;; ?\t has event-modifier 'control + (char-equal + (funcall (symbol-function 'event-to-character) + last-input-event) ?\t) + (and (not (event-modifiers last-input-event)) + (or (char-equal + (funcall (symbol-function 'event-to-character) + last-input-event) ?\?) + (char-equal + (funcall (symbol-function 'event-to-character) + last-input-event) ?\ )))))) t))) (defun tramp-completion-handle-file-exists-p (filename) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index a71667291da..c7edf9a4cdc 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -30,7 +30,7 @@ ;; are auto-frobbed from configure.ac, so you should edit that file and run ;; "autoconf && ./configure" to change them. -(defconst tramp-version "2.0.52" +(defconst tramp-version "2.0.53" "This version of Tramp.") (defconst tramp-bug-report-address "tramp-devel@gnu.org" diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 5fa9ac09b0b..877d5c9f399 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -895,6 +895,11 @@ indentation to be kept as it was before narrowing." (delete-char n) (setq ,bindent (- ,bindent n))))))))))) +(defun comment-add (arg) + (if (and (null arg) (= (string-match "[ \t]*\\'" comment-start) 1)) + comment-add + (1- (prefix-numeric-value arg)))) + (defun comment-region-internal (beg end cs ce &optional ccs cce block lines indent) "Comment region BEG .. END. @@ -999,7 +1004,6 @@ The strings used as comment starts are built from (defun comment-region-default (beg end &optional arg) (let* ((numarg (prefix-numeric-value arg)) - (add comment-add) (style (cdr (assoc comment-style comment-styles))) (lines (nth 2 style)) (block (nth 1 style)) @@ -1032,8 +1036,7 @@ The strings used as comment starts are built from ((consp arg) (uncomment-region beg end)) ((< numarg 0) (uncomment-region beg end (- numarg))) (t - (setq numarg (if (and (null arg) (= (length comment-start) 1)) - add (1- numarg))) + (setq numarg (comment-add arg)) (comment-region-internal beg end (let ((s (comment-padright comment-start numarg))) @@ -1091,9 +1094,8 @@ You can configure `comment-style' to change the way regions are commented." ;; FIXME: If there's no comment to kill on this line and ARG is ;; specified, calling comment-kill is not very clever. (if arg (comment-kill (and (integerp arg) arg)) (comment-indent)) - (let ((add (if arg (prefix-numeric-value arg) - (if (= (length comment-start) 1) comment-add 0)))) - ;; Some modes insist on keeping column 0 comment in column 0 + (let ((add (comment-add arg))) + ;; Some modes insist on keeping column 0 comment in column 0 ;; so we need to move away from it before inserting the comment. (indent-according-to-mode) (insert (comment-padright comment-start add)) diff --git a/lisp/pcvs-parse.el b/lisp/pcvs-parse.el index 2053d8f5bd5..892dc962767 100644 --- a/lisp/pcvs-parse.el +++ b/lisp/pcvs-parse.el @@ -271,8 +271,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." ;; on the current branch (either because it only exists in other ;; branches, or because it's been removed). (if (ignore-errors - (with-current-buffer - (find-file-noselect (expand-file-name + (with-temp-buffer + (insert-file-contents (expand-file-name ".cvsignore" (file-name-directory dir))) (goto-char (point-min)) (re-search-forward diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index b02df16b4f5..8120094f606 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -267,7 +267,8 @@ the evaluated constant value at compile time." ["Hungry delete" c-toggle-hungry-state :style toggle :selected c-hungry-delete-key] ["Subword mode" c-subword-mode - :style toggle :selected c-subword-mode]))) + :style toggle :selected (and (boundp 'c-subword-mode) + c-subword-mode)]))) ;;; Syntax tables. diff --git a/lisp/progmodes/gdb-ui.el b/lisp/progmodes/gdb-ui.el index 244570170fa..e6325f1de80 100644 --- a/lisp/progmodes/gdb-ui.el +++ b/lisp/progmodes/gdb-ui.el @@ -100,7 +100,9 @@ (defvar tool-bar-map) (defvar speedbar-initial-expansion-list-name) -(defvar gdb-frame-address "main" "Initialization for Assembler buffer.") +(defvar gdb-pc-address nil "Initialization for Assembler buffer. +Set to \"main\" at start if gdb-show-main is t.") +(defvar gdb-frame-address nil "Identity of frame for watch expression.") (defvar gdb-previous-frame-address nil) (defvar gdb-memory-address "main") (defvar gdb-previous-frame nil) @@ -109,8 +111,9 @@ (defvar gdb-current-language nil) (defvar gdb-var-list nil "List of variables in watch window. -Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS) where -STATUS is nil (unchanged), `changed' or `out-of-scope'.") +Each element has the form (VARNUM EXPRESSION NUMCHILD TYPE VALUE STATUS FP) +where STATUS is nil (unchanged), `changed' or `out-of-scope', FP the frame +address for root variables.") (defvar gdb-force-update t "Non-nil means that view of watch expressions will be updated in the speedbar.") (defvar gdb-main-file nil "Source file from which program execution begins.") @@ -417,7 +420,8 @@ With arg, use separate IO iff arg is positive." (goto-char (point-min)) (when (search-forward "read in on demand:" nil t) (while (re-search-forward gdb-source-file-regexp nil t) - (push (or (match-string 1) (match-string 2)) gdb-source-file-list)) + (push (file-name-nondirectory (or (match-string 1) (match-string 2))) + gdb-source-file-list)) (dolist (buffer (buffer-list)) (with-current-buffer buffer (when (and buffer-file-name @@ -515,7 +519,7 @@ With arg, use separate IO iff arg is positive." (setq comint-input-sender 'gdb-send) ;; (re-)initialize - (setq gdb-frame-address (if gdb-show-main "main" nil)) + (setq gdb-pc-address (if gdb-show-main "main" nil)) (setq gdb-previous-frame-address nil gdb-memory-address "main" gdb-previous-frame nil @@ -719,7 +723,7 @@ With arg, enter name of variable to be watched in the minibuffer." expr) (match-string 2) (match-string 3) - nil nil))) + nil nil gdb-frame-address))) (push var gdb-var-list) (speedbar 1) (unless (string-equal @@ -1205,7 +1209,7 @@ This filter may simply queue input for a later time." (cons (match-string 1 args) (string-to-number (match-string 2 args)))) - (setq gdb-frame-address (match-string 3 args)) + (setq gdb-pc-address (match-string 3 args)) ;; cover for auto-display output which comes *before* ;; stopped annotation (if (eq gdb-output-sink 'inferior) (setq gdb-output-sink 'user))) @@ -1356,7 +1360,7 @@ happens to be appropriate." (gdb-get-buffer-create 'gdb-breakpoints-buffer) (gdb-invalidate-breakpoints) ;; Do this through gdb-get-selected-frame -> gdb-frame-handler - ;; so gdb-frame-address is updated. + ;; so gdb-pc-address is updated. ;; (gdb-invalidate-assembler) (if (string-equal gdb-version "pre-6.4") @@ -3003,11 +3007,11 @@ BUFFER nil or omitted means use the current buffer." (pos 1) (address) (flag) (bptno)) (with-current-buffer buffer (save-excursion - (if (not (equal gdb-frame-address "main")) + (if (not (equal gdb-pc-address "main")) (progn (goto-char (point-min)) - (if (and gdb-frame-address - (search-forward gdb-frame-address nil t)) + (if (and gdb-pc-address + (search-forward gdb-pc-address nil t)) (progn (setq pos (point)) (beginning-of-line) @@ -3037,7 +3041,7 @@ BUFFER nil or omitted means use the current buffer." (goto-char (point-min)) (if (search-forward address nil t) (gdb-put-breakpoint-icon (eq flag ?y) bptno)))))))) - (if (not (equal gdb-frame-address "main")) + (if (not (equal gdb-pc-address "main")) (with-current-buffer buffer (set-window-point (get-buffer-window buffer 0) pos))))) @@ -3099,7 +3103,7 @@ BUFFER nil or omitted means use the current buffer." (special-display-frame-alist gdb-frame-parameters)) (display-buffer (gdb-get-buffer-create 'gdb-assembler-buffer)))) -;; modified because if gdb-frame-address has changed value a new command +;; modified because if gdb-pc-address has changed value a new command ;; must be enqueued to update the buffer with the new output (defun gdb-invalidate-assembler (&optional ignored) (if (gdb-get-buffer 'gdb-assembler-buffer) @@ -3108,7 +3112,7 @@ BUFFER nil or omitted means use the current buffer." (string-equal gdb-selected-frame gdb-previous-frame)) (if (or (not (member 'gdb-invalidate-assembler gdb-pending-triggers)) - (not (string-equal gdb-frame-address + (not (string-equal gdb-pc-address gdb-previous-frame-address))) (progn ;; take previous disassemble command, if any, off the queue @@ -3121,11 +3125,11 @@ BUFFER nil or omitted means use the current buffer." (gdb-enqueue-input (list (concat gdb-server-prefix "disassemble " - (if (member gdb-frame-address '(nil "main")) nil "0x") - gdb-frame-address "\n") + (if (member gdb-pc-address '(nil "main")) nil "0x") + gdb-pc-address "\n") 'gdb-assembler-handler)) (push 'gdb-invalidate-assembler gdb-pending-triggers) - (setq gdb-previous-frame-address gdb-frame-address) + (setq gdb-previous-frame-address gdb-pc-address) (setq gdb-previous-frame gdb-selected-frame))))))) (defun gdb-get-selected-frame () @@ -3140,8 +3144,10 @@ BUFFER nil or omitted means use the current buffer." (setq gdb-pending-triggers (delq 'gdb-get-selected-frame gdb-pending-triggers)) (goto-char (point-min)) - (if (re-search-forward "Stack level \\([0-9]+\\)" nil t) - (setq gdb-frame-number (match-string 1))) + (when (re-search-forward + "Stack level \\([0-9]+\\), frame at \\(0x[[:xdigit:]]+\\)" nil t) + (setq gdb-frame-number (match-string 1)) + (setq gdb-frame-address (match-string 2))) (goto-char (point-min)) (when (re-search-forward ".*=\\s-+0x0*\\(\\S-*\\)\\s-+in\\s-+\\(\\S-+?\\)\ \\(?: (\\(\\S-+?\\):[0-9]+?)\\)*;? " @@ -3153,7 +3159,7 @@ BUFFER nil or omitted means use the current buffer." (if (gdb-get-buffer 'gdb-assembler-buffer) (with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer) (setq mode-name (concat "Machine:" gdb-selected-frame)))) - (setq gdb-frame-address (match-string 1)) + (setq gdb-pc-address (match-string 1)) (if (and (match-string 3) gud-overlay-arrow-position) (let ((buffer (marker-buffer gud-overlay-arrow-position)) (position (marker-position gud-overlay-arrow-position))) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index 907a2e7c300..e1e2b9e28cd 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -374,8 +374,9 @@ t means that there is no stack, and we are in display-file mode.") (defun gud-speedbar-item-info () "Display the data type of the watch expression element." (let ((var (nth (- (line-number-at-pos (point)) 2) gdb-var-list))) - (if (nth 4 var) - (speedbar-message "%s" (nth 3 var))))) + (if (nth 6 var) + (speedbar-message "%s: %s" (nth 6 var) (nth 3 var)) + (speedbar-message "%s" (nth 3 var))))) (defun gud-install-speedbar-variables () "Install those variables used by speedbar to enhance gud/gdb." diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index f110828d602..5e645535a23 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -1744,6 +1744,14 @@ lines count as headers. #'python-eldoc-function) (add-hook 'eldoc-mode-hook '(lambda () (run-python nil t)) nil t) ; need it running + (unless (assoc 'python-mode hs-special-modes-alist) + (setq + hs-special-modes-alist + (cons (list + 'python-mode "^\\s-*def\\>" nil "#" + (lambda (arg)(python-end-of-defun)(skip-chars-backward " \t\n")) + nil) + hs-special-modes-alist))) (if (featurep 'hippie-exp) (set (make-local-variable 'hippie-expand-try-functions-list) (cons 'python-try-complete hippie-expand-try-functions-list))) diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 5c8477ac337..b194bb56727 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -1042,7 +1042,7 @@ Returns nil if line starts inside a string, t if in a comment." (defun tcl-send-string (proc string) (with-current-buffer (process-buffer proc) (goto-char (process-mark proc)) - (beginning-of-line) + (forward-line 0) ;Not (beginning-of-line) because of fields. (if (looking-at comint-prompt-regexp) (set-marker inferior-tcl-delete-prompt-marker (point)))) (comint-send-string proc string)) @@ -1050,7 +1050,7 @@ Returns nil if line starts inside a string, t if in a comment." (defun tcl-send-region (proc start end) (with-current-buffer (process-buffer proc) (goto-char (process-mark proc)) - (beginning-of-line) + (forward-line 0) ;Not (beginning-of-line) because of fields. (if (looking-at comint-prompt-regexp) (set-marker inferior-tcl-delete-prompt-marker (point)))) (comint-send-region proc start end)) @@ -1080,7 +1080,11 @@ See variable `inferior-tcl-buffer'." Prefix argument means switch to the Tcl buffer afterwards." (interactive "r\nP") (let ((proc (inferior-tcl-proc))) - (tcl-send-region proc start end) + (tcl-send-region + proc + ;; Strip leading and trailing whitespace. + (save-excursion (goto-char start) (skip-chars-forward " \t\n") (point)) + (save-excursion (goto-char end) (skip-chars-backward " \t\n") (point))) (tcl-send-string proc "\n") (if and-go (switch-to-tcl t)))) @@ -1149,7 +1153,12 @@ See documentation for function `inferior-tcl-mode' for more information." (unless (comint-check-proc "*inferior-tcl*") (set-buffer (apply (function make-comint) "inferior-tcl" cmd nil tcl-command-switches)) - (inferior-tcl-mode)) + (inferior-tcl-mode) + ;; Make tclsh display a prompt on ms-windows (or under Unix, when a tty + ;; wasn't used). Doesn't affect wish, unfortunately. + (unless (process-tty-name (inferior-tcl-proc)) + (tcl-send-string (inferior-tcl-proc) + "set ::tcl_interactive 1; concat\n"))) (set (make-local-variable 'tcl-application) cmd) (setq inferior-tcl-buffer "*inferior-tcl*") (pop-to-buffer "*inferior-tcl*")) diff --git a/lisp/subr.el b/lisp/subr.el index 344eccf816c..574c589448d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1540,7 +1540,8 @@ by doing (clear-string STRING)." (let ((pass nil) (c 0) (echo-keystrokes 0) - (cursor-in-echo-area t)) + (cursor-in-echo-area t) + (message-log-max nil)) (add-text-properties 0 (length prompt) minibuffer-prompt-properties prompt) (while (progn (message "%s%s" diff --git a/lisp/textmodes/org.el b/lisp/textmodes/org.el index 2ef9c60ce7c..936f8619fa2 100644 --- a/lisp/textmodes/org.el +++ b/lisp/textmodes/org.el @@ -5,7 +5,7 @@ ;; Author: Carsten Dominik <dominik at science dot uva dot nl> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://www.astro.uva.nl/~dominik/Tools/org/ -;; Version: 4.21 +;; Version: 4.24 ;; ;; This file is part of GNU Emacs. ;; @@ -81,9 +81,17 @@ ;; ;; Changes since version 4.00: ;; --------------------------- -;; Version 4.21 +;; Version 4.24 ;; - Bug fixes. ;; +;; Version 4.23 +;; - Bug fixes. +;; +;; Version 4.22 +;; - Bug fixes. +;; - In agenda buffer, mouse-1 no longer follows link. +;; See `org-agenda-mouse-1-follows-link' and `org-mouse-1-follows-link'. +;; ;; Version 4.20 ;; - Links use now the [[link][description]] format by default. ;; When inserting links, the user is prompted for a description. @@ -174,7 +182,7 @@ ;;; Customization variables -(defvar org-version "4.21" +(defvar org-version "4.24" "The version number of the file org.el.") (defun org-version () (interactive) @@ -227,7 +235,11 @@ uninteresting. Also tables look terrible when wrapped." (defcustom org-startup-align-all-tables nil "Non-nil means, align all tables when visiting a file. This is useful when the column width in tables is forced with <N> cookies -in table fields. Such tables will look correct only after the first re-align." +in table fields. Such tables will look correct only after the first re-align. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + #+STARTUP: align + #+STARTUP: noalign" :group 'org-startup :type 'boolean) @@ -237,7 +249,6 @@ This means, if you start editing an org file, you will get an immediate reminder of any due deadlines. This can also be configured on a per-file basis by adding one of the following lines anywhere in the buffer: - #+STARTUP: dlcheck #+STARTUP: nodlcheck" :group 'org-startup @@ -391,7 +402,12 @@ This has the effect that two stars are being added/taken away in promotion/demotion commands. It also influences how levels are handled by the exporters. Changing it requires restart of `font-lock-mode' to become effective -for fontification also in regions already fontified." +for fontification also in regions already fontified. +You may also set this on a per-file basis by adding one of the following +lines to the buffer: + + #+STARTUP: odd + #+STARTUP: oddeven" :group 'org-edit-structure :group 'org-font-lock :type 'boolean) @@ -870,6 +886,13 @@ Needs to be set before org.el is loaded." :group 'org-link-follow :type 'boolean) +(defcustom org-mouse-1-follows-link t + "Non-nil means, mouse-1 on a link will follow the link. +A longer mouse click will still set point. Does not wortk on XEmacs. +Needs to be set before org.el is loaded." + :group 'org-link-follow + :type 'boolean) + (defcustom org-mark-ring-length 4 "Number of different positions to be recorded in the ring Changing this requires a restart of Emacs to work correctly." @@ -1112,7 +1135,7 @@ closing date." :type 'boolean) (defgroup org-priorities nil - "Keywords in Org-mode." + "Priorities in Org-mode." :tag "Org Priorities" :group 'org-todo) @@ -1167,7 +1190,7 @@ moved to the new date." :type 'boolean) (defgroup org-tags nil - "Options concerning startup of Org-mode." + "Options concerning tags in Org-mode." :tag "Org Tags" :group 'org) @@ -1301,21 +1324,28 @@ forth between agenda and calendar." :tag "Org Agenda Window Setup" :group 'org-agenda) +(defcustom org-agenda-mouse-1-follows-link nil + "Non-nil means, mouse-1 on a link will follow the link in the agenda. +A longer mouse click will still set point. Does not wortk on XEmacs. +Needs to be set before org.el is loaded." + :group 'org-agenda-setup + :type 'boolean) + (defcustom org-select-timeline-window t "Non-nil means, after creating a timeline, move cursor into Timeline window. When nil, cursor will remain in the current window." - :group 'org-agenda-window-setup + :group 'org-agenda-setup :type 'boolean) (defcustom org-select-agenda-window t "Non-nil means, after creating an agenda, move cursor into Agenda window. When nil, cursor will remain in the current window." - :group 'org-agenda-window-setup + :group 'org-agenda-setup :type 'boolean) (defcustom org-fit-agenda-window t "Non-nil means, change window size of agenda to fit content." - :group 'org-agenda-window-setup + :group 'org-agenda-setup :type 'boolean) (defgroup org-agenda-display nil @@ -1884,7 +1914,12 @@ face is white for a light background, and black for a dark background. You may have to customize the face `org-hide' to make this work. Changing it requires restart of `font-lock-mode' to become effective -also in regions already fontified." +also in regions already fontified. +You may also set this on a per-file basis by adding one of the following +lines to the buffer: + + #+STARTUP: hidestars + #+STARTUP: showstars" :group 'org-font-lock :type 'boolean) @@ -2051,6 +2086,14 @@ Changing this variable requires a restart of Emacs to take effect." "Face for links." :group 'org-faces) +(defface org-date + '((((type tty) (class color)) (:foreground "cyan" :weight bold)) + (((class color) (background light)) (:foreground "Purple" :underline t)) + (((class color) (background dark)) (:foreground "Cyan" :underline t)) + (t (:bold t))) + "Face for links." + :group 'org-faces) + (defface org-tag '((((type tty) (class color)) (:weight bold)) (((class color) (background light)) (:weight bold)) @@ -2059,6 +2102,15 @@ Changing this variable requires a restart of Emacs to take effect." "Face for tags." :group 'org-faces) +(defface org-todo ;; font-lock-warning-face + '((((type tty) (class color)) (:foreground "red")) + (((class color) (background light)) (:foreground "Red" :bold t)) + (((class color) (background dark)) (:foreground "Red1" :bold t)) +; (((class color) (background dark)) (:foreground "Pink" :bold t)) + (t (:inverse-video t :bold t))) + "Face for TODO keywords." + :group 'org-faces) + (defface org-done ;; font-lock-type-face '((((type tty) (class color)) (:foreground "green")) (((class color) (background light)) (:foreground "ForestGreen" :bold t)) @@ -2165,7 +2217,9 @@ Changing this variable requires a restart of Emacs to take effect." ((equal key "STARTUP") (let ((opts (org-split-string value splitre)) (set '(("fold" org-startup-folded t) + ("overview" org-startup-folded t) ("nofold" org-startup-folded nil) + ("showall" org-startup-folded nil) ("content" org-startup-folded content) ("hidestars" org-hide-leading-stars t) ("showstars" org-hide-leading-stars nil) @@ -2379,6 +2433,10 @@ The following commands are available: s) (match-string-no-properties num string))) +(defsubst org-no-properties (s) + (remove-text-properties 0 (length s) org-rm-props s) + s) + (defun org-current-time () "Current time, possibly rounded to `org-time-stamp-rounding-minutes'." (if (> org-time-stamp-rounding-minutes 0) @@ -2406,7 +2464,8 @@ that will be added to PLIST. Returns the string that was modified." (if (featurep 'xemacs) [button2] [mouse-2]) 'org-open-at-mouse) (define-key org-mouse-map (if (featurep 'xemacs) [button3] [mouse-3]) 'org-find-file-at-mouse) -(define-key org-mouse-map [follow-link] 'mouse-face) +(when org-mouse-1-follows-link + (define-key org-mouse-map [follow-link] 'mouse-face)) (when org-tab-follows-link (define-key org-mouse-map [(tab)] 'org-open-at-point) (define-key org-mouse-map "\C-i" 'org-open-at-point)) @@ -2508,7 +2567,9 @@ that will be added to PLIST. Returns the string that was modified." (defun org-activate-bracket-links (limit) "Run through the buffer and add overlays to bracketed links." (if (re-search-forward org-bracket-link-regexp limit t) - (let* ((help (concat "LINK: " (org-match-string-no-properties 1))) + (let* ((help (concat "LINK: " + (org-match-string-no-properties 1))) + ;; FIXME: above we should remove the escapes. (ip (list 'invisible 'org-link 'intangible t 'rear-nonsticky t 'keymap org-mouse-map 'mouse-face 'highlight 'help-echo help)) @@ -2656,13 +2717,13 @@ between words." (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) - (if (memq 'date lk) '(org-activate-dates (0 'org-link t))) + (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) (if (memq 'camel lk) '(org-activate-camels (0 'org-link t))) (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) (if org-table-limit-column-width '(org-hide-wide-columns (0 nil append))) (list (concat "^\\*+[ \t]*" org-not-done-regexp) - '(1 'org-warning t)) + '(1 'org-todo t)) (list (concat "\\[#[A-Z]\\]") '(0 'org-special-keyword t)) (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) @@ -2683,7 +2744,7 @@ between words." '("| *\\(:?=[^|\n]*\\)" (1 'org-formula t)) '("^[ \t]*| *\\([#!$*_^]\\) *|" (1 'org-formula t)) (if org-format-transports-properties-p - '("| *\\(<[0-9]+>\\) *|" (1 'org-formula t))) + '("| *\\(<[0-9]+>\\) *" (1 'org-formula t))) ))) (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) ;; Now set the full font-lock-keywords @@ -3048,7 +3109,10 @@ or nil." (error (outline-next-heading))) (prog1 (match-string 0) (funcall outline-level))))) - (unless (bolp) (newline)) + (if (and (bolp) + (save-excursion (backward-char 1) (not (org-invisible-p)))) + (open-line 1) + (newline)) (insert head) (if (looking-at "[ \t]*") (replace-match " ")) @@ -4249,7 +4313,7 @@ used to insert the time stamp into the buffer to include the time." ;; the range start. (if (save-excursion (re-search-backward - (concat org-ts-regexp "--\\=") + (concat org-ts-regexp "--\\=") ; FIXME: exactly two minuses? (- (point) 20) t)) (apply 'encode-time @@ -4769,7 +4833,8 @@ The following commands are available: (if (featurep 'xemacs) [(button2)] [(mouse-2)]) 'org-agenda-goto-mouse) (define-key org-agenda-keymap (if (featurep 'xemacs) [(button3)] [(mouse-3)]) 'org-agenda-show-mouse) -(define-key org-agenda-keymap [follow-link] 'mouse-face) +(when org-agenda-mouse-1-follows-link + (define-key org-agenda-keymap [follow-link] 'mouse-face)) (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" '("Agenda" ("Agenda Files") @@ -5156,7 +5221,7 @@ NDAYS defaults to `org-agenda-ndays'." (d (- nt n1))) (- sd (+ (if (< d 0) 7 0) d))))) (day-numbers (list start)) -;FIXME (inhibit-redisplay t) + (inhibit-redisplay t) s e rtn rtnall file date d start-pos end-pos todayp nd) (setq org-agenda-redo-command (list 'org-agenda-list (list 'quote include-all) start-day ndays t)) @@ -5522,7 +5587,7 @@ With prefix ARG, go back that many times `org-agenda-ndays'." (org-disable-agenda-to-diary t)) (save-excursion (save-window-excursion - (list-diary-entries date 1))) + (list-diary-entries date 1))) ;; Keep this name for now, compatibility (if (not (get-buffer fancy-diary-buffer)) (setq entries nil) (with-current-buffer fancy-diary-buffer @@ -5966,7 +6031,7 @@ the documentation of `org-diary'." (org-add-props txt nil 'face 'org-scheduled-today 'undone-face 'org-scheduled-today 'done-face 'org-done - 'category category priority (+ 99 priority)) + 'category category 'priority (+ 99 priority)) (org-add-props txt nil 'priority priority 'category category))) (push txt ee)) (outline-next-heading)))) @@ -6227,7 +6292,7 @@ only the correctly processes TXT should be returned - this is used by (file-name-sans-extension (file-name-nondirectory buffer-file-name)) ""))) - (tag (or (nth (1- (or (length tags) 0)) tags) "")) + (tag (if tags (nth (1- (length tags)) tags) "")) time ;; needed for the eval of the prefix format (ts (if dotime (concat (if (stringp dotime) dotime "") txt))) (time-of-day (and dotime (org-get-time-of-day ts))) @@ -7282,7 +7347,10 @@ optional argument IN-EMACS is non-nil, Emacs will visit the file." (format "Execute \"%s\" in shell? " (org-add-props cmd nil 'face 'org-warning)))) - (shell-command cmd) + (progn + (message "Executing %s..." cmd) + (shell-command cmd) + (message "Executing %s...done" cmd)) (error "Abort")))) (t @@ -7670,6 +7738,28 @@ folders." (kill-this-buffer) (error "Message not found")))) +(defun org-upgrade-old-links (&optional query-description) + "Transfer old <...> style links to new [[...]] style links. +With arg query-description, ask at each match for a description text to use +for this link." + (interactive (list (y-or-n-p "Would you like to be queried for a description at each link?"))) + (save-excursion + (goto-char (point-min)) + (let ((re (concat "\\([^[]\\)<\\(" + "\\(" (mapconcat 'identity org-link-types "\\|") + "\\):" + "[^" org-non-link-chars "]+\\)>")) + l1 l2 (cnt 0)) + (while (re-search-forward re nil t) + (setq cnt (1+ cnt) + l1 (org-match-string-no-properties 2) + l2 (save-match-data (org-link-escape l1))) + (when query-description (setq l1 (read-string "Desc: " l1))) + (if (equal l1 l2) + (replace-match (concat (match-string 1) "[[" l1 "]]") t t) + (replace-match (concat (match-string 1) "[[" l2 "][" l1 "]]") t t))) + (message "%d matches have beed treated" cnt)))) + (defun org-open-file (path &optional in-emacs line search) "Open the file at PATH. First, this expands any special file name abbreviations. Then the @@ -8619,7 +8709,7 @@ This is being used to correctly align a single field after TAB or RET.") (> (org-string-width xx) fmax)) (org-add-props xx nil 'help-echo - (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (copy-sequence xx))) + (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) (unless (> f1 1) (error "Cannot narrow field starting with wide link \"%s\"" @@ -10153,7 +10243,8 @@ $1-> %s\n" orig formula form)) (org-table-align))))) (defun org-table-recalculate (&optional all noalign) - "Recalculate the current table line by applying all stored formulas." + "Recalculate the current table line by applying all stored formulas. +With prefix arg ALL, do this for all lines in the table." (interactive "P") (or (memq this-command org-recalc-commands) (setq org-recalc-commands (cons this-command org-recalc-commands))) @@ -11376,7 +11467,7 @@ Does include HTML export options as well as TODO and CATEGORY stuff." (mapconcat 'identity org-todo-keywords " ") "Me Jason Marie DONE") (cdr (assoc org-startup-folded - '((nil . "nofold")(t . "fold")(content . "content")))) + '((nil . "showall") (t . "overview") (content . "content")))) (if org-startup-with-deadline-check "dlcheck" "nodlcheck") (if org-odd-levels-only "odd" "oddeven") (if org-hide-leading-stars "hidestars" "showstars") @@ -11718,8 +11809,9 @@ headlines. The default is 3. Lower levels will become bulleted lists." (concat "<img src=\"" thefile "\"/>") (concat "<a href=\"" thefile "\">" desc "</a>"))))) ((member type '("bbdb" "vm" "wl" "mhe" "rmail" "gnus" "shell")) - (setq rpl (concat "<i><" type ":" path "></i>")))) - ;; FIXME: We get to see the escaped links!!!!! + (setq rpl (concat "<i><" type ":" + (save-match-data (org-link-unescape path)) + "></i>")))) (setq line (replace-match rpl t t line) start (+ start (length rpl)))) ;; TODO items @@ -12196,6 +12288,89 @@ file, but with extension `.ics'." (interactive) (org-export-icalendar nil buffer-file-name)) +(defun org-export-as-xml () + "Export current buffer as XOXO XML buffer." + (interactive) + (cond ((eq org-export-xml-type 'xoxo) + (org-export-as-xoxo (current-buffer))))) + +(defun org-export-as-xoxo-insert-into (buffer &rest output) + (with-current-buffer buffer + (apply 'insert output))) + +(defun org-export-as-xoxo (&optional buffer) + "Export the org buffer as XOXO. +The XOXO buffer is named *xoxo-<source buffer name>*" + (interactive (list (current-buffer))) + ;; A quickie abstraction + + ;; Output everything as XOXO + (with-current-buffer (get-buffer buffer) + (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. + (let* ((filename (concat (file-name-sans-extension buffer-file-name) + ".xml")) + (out (find-file-noselect filename)) + (last-level 1) + (hanging-li nil)) + ;; Check the output buffer is empty. + (with-current-buffer out (erase-buffer)) + ;; Kick off the output + (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n") + (while (re-search-forward "^\\(\\*+\\) \\(.+\\)" (point-max) 't) + (let* ((hd (match-string-no-properties 1)) + (level (length hd)) + (text (concat + (match-string-no-properties 2) + (save-excursion + (goto-char (match-end 0)) + (let ((str "")) + (catch 'loop + (while 't + (forward-line) + (if (looking-at "^[ \t]\\(.*\\)") + (setq str (concat str (match-string-no-properties 1))) + (throw 'loop str))))))))) + + ;; Handle level rendering + (cond + ((> level last-level) + (org-export-as-xoxo-insert-into out "\n<ol>\n")) + + ((< level last-level) + (dotimes (- (- last-level level) 1) + (if hanging-li + (org-export-as-xoxo-insert-into out "</li>\n")) + (org-export-as-xoxo-insert-into out "</ol>\n")) + (when hanging-li + (org-export-as-xoxo-insert-into out "</li>\n") + (setq hanging-li nil))) + + ((equal level last-level) + (if hanging-li + (org-export-as-xoxo-insert-into out "</li>\n"))) + ) + + (setq last-level level) + + ;; And output the new li + (setq hanging-li 't) + (if (equal ?+ (elt text 0)) + (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>") + (org-export-as-xoxo-insert-into out "<li>" text)))) + + ;; Finally finish off the ol + (dotimes (- last-level 1) + (if hanging-li + (org-export-as-xoxo-insert-into out "</li>\n")) + (org-export-as-xoxo-insert-into out "</ol>\n")) + + ;; Finish the buffer off and clean it up. + (switch-to-buffer-other-window out) + (indent-region (point-min) (point-max)) + (save-buffer) + (goto-char (point-min)) + ))) + ;;;###autoload (defun org-export-icalendar-all-agenda-files () "Export all files in `org-agenda-files' to iCalendar .ics files. @@ -12742,19 +12917,36 @@ See the individual commands for more information." (org-paste-subtree arg))) (defun org-ctrl-c-ctrl-c (&optional arg) - "Call realign table, or recognize a table.el table, or update keywords. -When the cursor is inside a table created by the table.el package, -activate that table. Otherwise, if the cursor is at a normal table -created with org.el, re-align that table. This command works even if -the automatic table editor has been turned off. - -If the cursor is in a headline, prompt for tags and insert them into -the current line, aligned to `org-tags-column'. When in a headline and -called with prefix arg, realign all tags in the current buffer. - -If the cursor is in one of the special #+KEYWORD lines, this triggers -scanning the buffer for these lines and updating the information. -If the cursor is on a #+TBLFM line, re-apply the formulae to the table." + "Set tags in headline, or update according to changed information at point. + +This command does many different things, depending on context: + +- If the cursor is in a headline, prompt for tags and insert them + into the current line, aligned to `org-tags-column'. When called + with prefix arg, realign all tags in the current buffer. + +- If the cursor is in one of the special #+KEYWORD lines, this + triggers scanning the buffer for these lines and updating the + information. + +- If the cursor is inside a table, realign the table. This command + works even if the automatic table editor has been turned off. + +- If the cursor is on a #+TBLFM line, re-apply the formulas to + the entire table. + +- If the cursor is inside a table created by the table.el package, + activate that table. + +- If the current buffer is a remember buffer, close note and file it. + with a prefix argument, file it without further interaction to the default + location. + +- If the cursor is on a <<<target>>>, update radio targets and corresponding + links in this buffer. + +- If the cursor is on a numbered item in a plain list, renumber the + ordered list." (interactive "P") (let ((org-enable-table-editor t)) (cond @@ -13091,9 +13283,10 @@ With optional NODE, go directly to that node." ;; through to `fill-paragraph' when appropriate. (set (make-local-variable 'fill-paragraph-function) 'org-fill-paragraph) ;; Adaptive filling: To get full control, first make sure that - ;; `adaptive-fill-regexp' never matches. Then install our won matcher. - (setq adaptive-fill-regexp "\000") - (setq adaptive-fill-function 'org-adaptive-fill-function)) + ;; `adaptive-fill-regexp' never matches. Then install our own matcher. + (set (make-local-variable 'adaptive-fill-regexp) "\000") + (set (make-local-variable 'adaptive-fill-function) + 'org-adaptive-fill-function)) (defun org-fill-paragraph (&optional justify) "Re-align a table, pass through to fill-paragraph if no table." @@ -13368,7 +13561,6 @@ Show the heading too, if it is currently invisible." (or (match-beginning 1) (point-max))) (if org-noutline-p nil ?\n)))) - (defun org-make-options-regexp (kwds) "Make a regular expression for keyword lines." (concat @@ -13402,114 +13594,6 @@ Show the heading too, if it is currently invisible." (run-hooks 'org-load-hook) -;; Experimental code -;; FIXME: Move this code when it is ready. - -(defun org-upgrade-old-links (&optional query-description) - "Transfer old <...> style links to new [[...]] style links. -With arg query-description, ask at each match for a description text to use -for this link." - (interactive (list (y-or-n-p "Would you like to be queried for a description at each link?"))) - (save-excursion - (goto-char (point-min)) - (let ((re (concat "\\([^[]\\)<\\(" - "\\(" (mapconcat 'identity org-link-types "\\|") - "\\):" - "[^" org-non-link-chars "]+\\)>")) - l1 l2 (cnt 0)) - (while (re-search-forward re nil t) - (setq cnt (1+ cnt) - l1 (org-match-string-no-properties 2) - l2 (save-match-data (org-link-escape l1))) - (when query-description (setq l1 (read-string "Desc: " l1))) - (if (equal l1 l2) - (replace-match (concat (match-string 1) "[[" l1 "]]") t t) - (replace-match (concat (match-string 1) "[[" l2 "][" l1 "]]") t t))) - (message "%d matches have beed treated" cnt)))) - -(defun org-export-as-xml () - "Export current buffer as XOXO XML buffer." - (interactive) - (cond ((eq org-export-xml-type 'xoxo) - (org-export-as-xoxo (current-buffer))))) - -(defun org-export-as-xoxo-insert-into (buffer &rest output) - (with-current-buffer buffer - (apply 'insert output))) - -(defun org-export-as-xoxo (&optional buffer) - "Export the org buffer as XOXO. -The XOXO buffer is named *xoxo-<source buffer name>*" - (interactive (list (current-buffer))) - ;; A quickie abstraction - - ;; Output everything as XOXO - (with-current-buffer (get-buffer buffer) - (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - (let* ((filename (concat (file-name-sans-extension buffer-file-name) - ".xml")) - (out (find-file-noselect filename)) - (last-level 1) - (hanging-li nil)) - ;; Check the output buffer is empty. - (with-current-buffer out (erase-buffer)) - ;; Kick off the output - (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n") - (while (re-search-forward "^\\(\\*+\\) \\(.+\\)" (point-max) 't) - (let* ((hd (match-string-no-properties 1)) - (level (length hd)) - (text (concat - (match-string-no-properties 2) - (save-excursion - (goto-char (match-end 0)) - (let ((str "")) - (catch 'loop - (while 't - (forward-line) - (if (looking-at "^[ \t]\\(.*\\)") - (setq str (concat str (match-string-no-properties 1))) - (throw 'loop str))))))))) - - ;; Handle level rendering - (cond - ((> level last-level) - (org-export-as-xoxo-insert-into out "\n<ol>\n")) - - ((< level last-level) - (dotimes (- (- last-level level) 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "</li>\n")) - (org-export-as-xoxo-insert-into out "</ol>\n")) - (when hanging-li - (org-export-as-xoxo-insert-into out "</li>\n") - (setq hanging-li nil))) - - ((equal level last-level) - (if hanging-li - (org-export-as-xoxo-insert-into out "</li>\n"))) - ) - - (setq last-level level) - - ;; And output the new li - (setq hanging-li 't) - (if (equal ?+ (elt text 0)) - (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>") - (org-export-as-xoxo-insert-into out "<li>" text)))) - - ;; Finally finish off the ol - (dotimes (- last-level 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "</li>\n")) - (org-export-as-xoxo-insert-into out "</ol>\n")) - - ;; Finish the buffer off and clean it up. - (switch-to-buffer-other-window out) - (indent-region (point-min) (point-max) nil) - (save-buffer) - (goto-char (point-min)) - ))) - ;; arch-tag: e77da1a7-acc7-4336-b19e-efa25af3f9fd ;;; org.el ends here diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 97153e31a25..8ca7c3026e8 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -594,20 +594,24 @@ An alternative value is \" . \", if you use a font with a narrow period." '(face subscript display (raise -0.3)) '(face superscript display (raise +0.3))))) +(defun tex-font-lock-match-suscript (limit) + "Match subscript and superscript patterns up to LIMIT." + (when (re-search-forward "[_^] *\\([^\n\\{}]\\|\ +\\\\\\([a-zA-Z@]+\\|[^ \t\n]\\)\\|{[^\\{]*}\\|\\({\\)\\)" limit t) + (when (match-end 3) + (let ((beg (match-beginning 3)) + (end (save-restriction + (narrow-to-region (point-min) limit) + (condition-case nil (scan-lists (point) 1 1) (error nil))))) + (store-match-data (if end + (list (match-beginning 0) end beg end) + (list beg beg beg beg))))) + t)) + (defconst tex-font-lock-keywords-3 (append tex-font-lock-keywords-2 - (eval-when-compile - (let ((general "\\([a-zA-Z@]+\\|[^ \t\n]\\)") - (slash "\\\\") - ;; This is not the same regexp as before: it has a `+' removed. - ;; The + makes the matching faster in the above cases (where we can - ;; exit as soon as the match fails) but would make this matching - ;; degenerate to nasty complexity (because we try to match the - ;; closing brace, which forces trying all matching combinations). - (arg "{\\(?:[^{}\\]\\|\\\\.\\|{[^}]*}\\)*")) - `((,(concat "[_^] *\\([^\n\\{}#]\\|" slash general "\\|#[0-9]\\|" arg "}\\)") - (1 (tex-font-lock-suscript (match-beginning 0)) - append)))))) + '((tex-font-lock-match-suscript + (1 (tex-font-lock-suscript (match-beginning 0)) append)))) "Experimental expressions to highlight in TeX modes.") (defvar tex-font-lock-keywords tex-font-lock-keywords-1 diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el index 3e3fcf78ae6..1c51c4c55ab 100644 --- a/lisp/time-stamp.el +++ b/lisp/time-stamp.el @@ -5,7 +5,7 @@ ;; This file is part of GNU Emacs. -;; Maintainer's Time-stamp: <2006-02-06 15:11:58 ttn> +;; Maintainer's Time-stamp: <2006-04-12 20:30:56 rms> ;; Maintainer: Stephen Gildea <gildea@stop.mail-abuse.org> ;; Keywords: tools @@ -93,6 +93,7 @@ historical default." :type 'string :group 'time-stamp :version "20.1") +;;;###autoload(put 'time-stamp-format 'safe-local-variable 'stringp) (defcustom time-stamp-active t "*Non-nil to enable time-stamping of buffers by \\[time-stamp]. @@ -150,7 +151,7 @@ Do not change `time-stamp-line-limit', `time-stamp-start', incompatible with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself.") - +;;;###autoload(put 'time-stamp-line-limit 'safe-local-variable 'integerp) (defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+" ;Do not change! "Regexp after which the time stamp is written by \\[time-stamp]. @@ -163,7 +164,7 @@ Do not change `time-stamp-line-limit', `time-stamp-start', incompatible with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself.") - +;;;###autoload(put 'time-stamp-start 'safe-local-variable t) (defvar time-stamp-end "\\\\?[\">]" ;Do not change! "Regexp marking the text after the time stamp. @@ -183,6 +184,7 @@ Do not change `time-stamp-start', `time-stamp-end', `time-stamp-pattern', or `time-stamp-inserts-lines' for yourself or you will be incompatible with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself.") +;;;###autoload(put 'time-stamp-end 'safe-local-variable t) (defvar time-stamp-inserts-lines nil ;Do not change! @@ -199,6 +201,7 @@ Do not change `time-stamp-end' or `time-stamp-inserts-lines' for yourself or you will be incompatible with other people's files! If you must change them for some application, do so in the local variables section of the time-stamped file itself.") +;;;###autoload(put 'time-stamp-inserts-lines 'safe-local-variable t) (defvar time-stamp-count 1 ;Do not change! @@ -209,6 +212,7 @@ Do not change `time-stamp-count' for yourself or you will be incompatible with other people's files! If you must change it for some application, do so in the local variables section of the time-stamped file itself.") +;;;###autoload(put 'time-stamp-count 'safe-local-variable 'integerp) (defvar time-stamp-pattern nil ;Do not change! @@ -244,6 +248,7 @@ Do not change `time-stamp-pattern' `time-stamp-line-limit', incompatible with other people's files! If you must change them for some application, do so only in the local variables section of the time-stamped file itself.") +;;;###autoload(put 'time-stamp-pattern 'safe-local-variable 'stringp) diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 8dc811c09e6..cacd6f59670 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -47,11 +47,15 @@ ;; would be accompanied by a full redisplay. (define-minor-mode tooltip-mode - "Toggle Tooltip display. -With ARG, turn tooltip mode on if and only if ARG is positive. + "Toggle Tooltip mode. +With ARG, turn Tooltip mode on if and only if ARG is positive. When this minor mode is enabled, Emacs displays help text -in a pop-up window on mouse-over. When it is disabled, -Emacs displays the help text in the echo area instead." +in a pop-up window for buttons and menu items that you put the mouse on. +\(However, if `tooltip-use-echo-area' is non-nil, this and +all pop-up help appears in the echo area.) + +When Tooltip mode is disabled, Emacs displays one line of +the help text in the echo area, and does not make a pop-up window." :global t :init-value (not (or noninteractive emacs-basic-display @@ -142,7 +146,9 @@ position to pop up the tooltip." :group 'basic-faces) (defcustom tooltip-use-echo-area nil - "Use the echo area instead of tooltip frames for help and GUD tooltips." + "Use the echo area instead of tooltip frames for help and GUD tooltips. +To display multi-line help text in the echo area, set this to t +and enable `tooltip-mode'." :type 'boolean :group 'tooltip) diff --git a/lisp/vc.el b/lisp/vc.el index 19b2f0f4a72..61b8aa05a4b 100644 --- a/lisp/vc.el +++ b/lisp/vc.el @@ -3107,7 +3107,11 @@ colors. `vc-annotate-background' specifies the background color." (vc-ensure-vc-buffer) (setq vc-annotate-display-mode display-mode) ;Not sure why. --Stef (let* ((temp-buffer-name (format "*Annotate %s (rev %s)*" (buffer-name) rev)) - (temp-buffer-show-function 'vc-annotate-display-select)) + (temp-buffer-show-function 'vc-annotate-display-select) + ;; If BUF is specified, we presume the caller maintains current line, + ;; so we don't need to do it here. This implementation may give + ;; strange results occasionally in the case of REV != WORKFILE-REV. + (current-line (unless buf (line-number-at-pos)))) (message "Annotating...") ;; If BUF is specified it tells in which buffer we should put the ;; annotations. This is used when switching annotations to another @@ -3129,6 +3133,8 @@ colors. `vc-annotate-background' specifies the background color." (set (make-local-variable 'vc-annotate-parent-rev) rev) (set (make-local-variable 'vc-annotate-parent-display-mode) display-mode))) + (when current-line + (goto-line current-line temp-buffer-name)) (message "Annotating... done"))) (defun vc-annotate-prev-version (prefix) @@ -3310,8 +3316,8 @@ The annotations are relative to the current time, unless overridden by OFFSET." (let* ((color (or (vc-annotate-compcar difference vc-annotate-color-map) (cons nil vc-annotate-very-old-color))) ;; substring from index 1 to remove any leading `#' in the name - (face-name (concat "vc-annotate-face-" - (if (string-equal + (face-name (concat "vc-annotate-face-" + (if (string-equal (substring (cdr color) 0 1) "#") (substring (cdr color) 1) (cdr color)))) |