diff options
Diffstat (limited to 'lisp')
104 files changed, 10016 insertions, 5108 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 89843d82462..c5fe2fa802c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,759 @@ +2004-09-03 Luc Teirlinck <teirllm@auburn.edu> + + * autorevert.el (auto-revert-handler): Bind `buffer-read-only' + locally around the call to `revert-buffer'. + +2004-09-03 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-toggle-regexp): Set `isearch-success' and + `isearch-adjusted' to `t'. + (isearch-toggle-case-fold): Set `isearch-success' to `t'. + (isearch-message-prefix): Add "pending" for isearch-adjusted. + (isearch-other-meta-char): Restore isearch-point unconditionally. + (isearch-query-replace): Add new arg `regexp-flag' and use it. + Set point to start of match if region is not active in transient + mark mode (to include the current match to region boundaries). + Push the search string to `query-replace-from-history-variable'. + Add prompt "Query replace regexp" for isearch-regexp. + Add region beginning/end as last arguments of `perform-replace.' + (isearch-query-replace-regexp): Replace code by the call to + `isearch-query-replace' with arg `t'. + +2004-09-03 Richard M. Stallman <rms@gnu.org> + + * startup.el (normal-top-level): Undo previous TERM change. + +2004-09-03 Kim F. Storm <storm@cua.dk> + + * emulation/cua-rect.el (cua--overlay-keymap): New keymap for + highlight overlays; allow using RET when cursor is over a button. + (cua--highlight-rectangle): Use it. + (cua--rectangle-set-corners): Don't move backwards at eol. + (cua--forward-line): Don't move into void after eob. + + * emulation/cua-rect.el (cua--rectangle-set-corners): Ensure that + point is set (and displayed) inside rectangle. + (cua--rectangle-operation): Fix for highlight of empty lines. + (cua--highlight-rectangle): Fix highlight for tabs. + Position cursor at left/right edge of rectangle using new `cursor' + property on overlay strings. + (cua--indent-rectangle): Don't tabify. + (cua-rotate-rectangle): Ignore that point has moved. + +2004-09-02 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp> + + * term/mac-win.el: Add ASCII equivalents for some function keys. + (mode-line-frame-identification): Sync with x-win.el. + +2004-09-02 Juri Linkov <juri@jurta.org> + + * progmodes/compile.el (compilation-buffer-name): Compare major + mode with second element of compilation-arguments instead of third + to reflect latest changes in compilation-arguments structure. + (recompile): Use global variable `compilation-directory' to get + recent compilation directory only when `recompile' is invoked NOT + in the compilation buffer. Otherwise, use `default-directory' of + the compilation buffer. + (compilation-error-properties): Allow to funcall col and end-col. + (compilation-mode-font-lock-keywords): Check col and end-col by + `integerp'. + (compilation-goto-locus): If end-mk is non-nil in transient mark + mode don't activate the mark (and don't display message in + push-mark), but highlight overlay between mk and end-mk. + + * progmodes/grep.el (grep-highlight-matches): New defcustom. + (grep-regexp-alist): Add rule to highlight grep matches. + (grep-process-setup): Set env-vars GREP_OPTIONS and GREP_COLOR. + + * info.el (Info-fontify-node): Don't compute other-tag + if Info-hide-note-references=hide. + + * help.el (function-called-at-point): + * help-fns.el (variable-at-point): + Try `find-tag-default' when other methods failed. + + * emacs-lisp/lisp.el (beginning-of-defun, end-of-defun): + Do not push mark if inhibit-mark-movement is non-nil. + + * textmodes/ispell.el (ispell-html-skip-alists): + Fix backslashes in docstring. + +2004-09-01 Juri Linkov <juri@jurta.org> + + * isearch.el (isearch-wrap-function) + (isearch-push-state-function): New defvars. + (isearch-pop-fun-state): New defsubst. + (isearch-top-state): Call function saved in `isearch-pop-fun-state'. + (isearch-push-state): Set the result of calling + `isearch-push-state-function' to the `isearch-pop-fun-state' field. + (isearch-cancel): Call function saved in `isearch-pop-fun-state' to + restore the mode-specific starting point of terminated search. + (isearch-abort): Call `isearch-cancel' instead of its duplicated code. + (isearch-repeat): Call `isearch-wrap-function' if defined. + (isearch-message-prefix): Don't add prefix "over" to the message + for wrapped search if `isearch-wrap-function' is defined. + (isearch-search): Call function saved in `isearch-pop-fun-state' to + restore the mode-specific starting point of failed search. + + * info.el (Info-search-whitespace-regexp): Fix backslashes. + (Info-search): Add new optional arguments for the sake of isearch. + Replace whitespace in Info-search-whitespace-regexp literally. + Add backward search. Don't call `Info-select-node' if regexp is + found in the same Info node. Don't add node to Info-history for + wrapped isearch. + (Info-search-backward, Info-isearch-search, Info-isearch-wrap) + (Info-isearch-push-state, Info-isearch-pop-state): New funs. + (Info-mode): Set local variables `isearch-search-fun-function', + `isearch-wrap-function', `isearch-push-state-function', + `search-whitespace-regexp'. + + * isearch.el: Remove ancient Change Log section. + (isearch-string, isearch-message-string, isearch-point) + (isearch-success, isearch-forward-flag, isearch-other-end) + (isearch-word, isearch-invalid-regexp, isearch-wrapped) + (isearch-barrier, isearch-within-brackets) + (isearch-case-fold-search): Add suffix `-state' to state-related + defsubsts to avoid name clashes with other function names. + + * simple.el (next-error): New defgroup and defface. + (next-error-highlight, next-error-highlight-no-select): + New defcustoms. + (next-error-no-select): Let-bind next-error-highlight to the value + of next-error-highlight-no-select before calling `next-error'. + + * progmodes/compile.el (compilation-goto-locus): + Use `next-error' face instead of `region'. Set 4-th argument of + `move-overlay' to `current-buffer' to move overlay to different + source buffers. Use new variable `next-error-highlight'. + + * simple.el (next-error-find-buffer): Move the rule + "if current buffer is a next-error capable buffer" after the + rule "if next-error-last-buffer is set to a live buffer". + Simplify to test all rules in one `or'. + (next-error): Doc fix. + (next-error, previous-error, first-error) + (next-error-no-select, previous-error-no-select): + Make arguments optional. + +2004-08-31 Luc Teirlinck <teirllm@auburn.edu> + + * macros.el (apply-macro-to-region-lines): Make it operate on all + lines that begin in the region, rather than on all complete lines + in the region. + +2004-08-31 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * x-dnd.el (x-dnd-protocol-alist): Document update. + (x-dnd-known-types): Defcustom it. + (x-dnd-handle-motif): Print message-atom in error message. + +2004-08-30 John Paul Wallington <jpw@gnu.org> + + * textmodes/tex-mode.el (tex-validate-buffer): Use distinct + strings rather than programatically constructing message. + +2004-08-30 Richard M. Stallman <rms@gnu.org> + + * emacs-lisp/lisp-mode.el (prin1-char): Don't turn S-a into A. + Don't return a string that would read as the wrong character code. + +2004-08-29 Kim F. Storm <storm@cua.dk> + + * emulation/cua-base.el (cua-auto-expand-rectangles): Remove + automatic rectangle padding feature; replace by non-destructive + virtual rectangle edges feature. + (cua-virtual-rectangle-edges): New defcustom. + (cua-auto-tabify-rectangles): New defcustom. + (cua-paste): If paste into a marked rectangle, insert rectangle at + current column, even if virtual; also paste exactly as many lines + as has been marked (ignore additional lines or add empty lines), + but paste whole source if only one line is marked. + (cua--update-indications): No longer use overwrite-cursor to + indicate rectangle padding + + * emulation/cua-rect.el (cua--rectangle-padding): Remove. + (cua--rectangle-virtual-edges): New defun. + (cua--rectangle-get-corners): Remove optional PAD arg. + (cua--rectangle-set-corners): Never do padding. + (cua--forward-line): Remove optional PAD arg. Simplify. + (cua-resize-rectangle-right, cua-resize-rectangle-left) + (cua-resize-rectangle-down, cua-resize-rectangle-up): + (cua-resize-rectangle-bot, cua-resize-rectangle-top) + (cua-resize-rectangle-page-up, cua-resize-rectangle-page-down) + (cua--rectangle-move): Never do padding. Simplify. + (cua--tabify-start): New defun. + (cua--rectangle-operation): Add tabify arg. All callers changed. + (cua--pad-rectangle): Remove. + (cua--delete-rectangle): Handle delete with virtual edges. + (cua--extract-rectangle): Add spaces if rectangle has virtual edges. + (cua--insert-rectangle): Handle insert at virtual column. + Perform auto-tabify if necessary. + (cua--activate-rectangle): Remove optional FORCE arg. + Never do padding. Simplify. + (cua--highlight-rectangle): Enhance for virtual edges. + (cua-toggle-rectangle-padding): Remove command. + (cua-toggle-rectangle-virtual-edges): New command. + (cua-sequence-rectangle): Add optional TABIFY arg. Callers changed. + (cua--rectangle-post-command): Don't force rectangle padding. + (cua--init-rectangles): Bind M-p to cua-toggle-rectangle-virtual-edges. + +2004-08-28 Luc Teirlinck <teirllm@auburn.edu> + + * indent.el (edit-tab-stops-buffer): Doc fix. + +2004-08-28 Richard M. Stallman <rms@gnu.org> + + * progmodes/grep.el (grep-default-command): Use find-tag-default. + (grep-tag-default): Function deleted. + + * subr.el (find-tag-default): Moved from etags.el. + + * progmodes/etags.el (find-tag-default): Moved to subr.el. + + * emacs-lisp/lisp-mode.el (prin1-char): Put `shift' modifier + into the basic character if it has an uppercase form. + +2004-08-27 Kenichi Handa <handa@m17n.org> + + * international/utf-8.el (utf-8-post-read-conversion): If the + buffer is unibyte, temporarily make it multibyte. + +2004-08-27 Masatake YAMATO <jet@gyve.org> + + * calendar/time-date.el (time-to-seconds): Add autoload cookies. + +2004-08-25 John Paul Wallington <jpw@gnu.org> + + * textmodes/tex-mode.el (tex-validate-buffer): Distinguish between + 0, 1, and many mismatches in message. + (tex-start-shell): Use `set-process-query-on-exit-flag'. + + * ielm.el (ielm-tab, ielm-complete-symbol): Doc fix. + (inferior-emacs-lisp-mode): Use `set-process-query-on-exit-flag'. + +2004-08-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-svn.el (vc-svn-diff): Treat options from vc-svn-diff-switches and + vc-diff-switches differently. + +2004-08-22 Luc Teirlinck <teirllm@auburn.edu> + + * speedbar.el (speedbar-file-regexp): Give it a phony defvar + before and a real defvar after + `speedbar-supported-extension-expressions'. This is to silence + the compiler without breaking bootstrapping. + +2004-08-22 Richard M. Stallman <rms@gnu.org> + + * textmodes/flyspell.el (flyspell-word): + Use set-process-query-on-exit-flag. + (flyspell-highlight-duplicate-region): Take POSS as arg. + (flyspell-word): Pass POSS as arg. + + * progmodes/ada-xref.el: Many doc and style fixes. + (ada-find-any-references): Use compilation-start. + (ada-get-ali-file-name): Improve error msg. + (ada-get-ada-file-name): Likewise. + + * net/ange-ftp.el (ange-ftp-gwp-start, ange-ftp-nslookup-host) + (ange-ftp-start-process): Use set-process-query-on-exit-flag. + + * mail/mail-extr.el (mail-extr-all-top-level-domains): + Add forward defvar. + + * whitespace.el (global-whitespace-mode): New alias + for whitespace-global-mode. + + * speedbar.el (speedbar-file-regexp): Definition moved up. + (speedbar-mode, speedbar-set-mode-line-format): + Use with-no-warnings. + (speedbar-emacs-popup-kludge): Delete Emacs 19 alternative. + + * simple.el (shell-command-on-region): New arg DISPLAY-ERROR-BUFFER + controls whether to display the error buffer. + + * ps-mule.el: Delete compatibility code for old Emacses. + (ps-mule-find-wrappoint): Don't use chars-in-region. + + * frame.el (display-mouse-p, display-selections-p): + Use with-no-warnings. + + * font-lock.el (font-lock-set-defaults): Use with-no-warnings. + +2004-08-22 David Kastrup <dak@gnu.org> + + * textmodes/reftex-auc.el, progmodes/meta-mode.el: Update AUCTeX + information. + + * speedbar.el, iswitchb.el, ido.el: Update AUCTeX information. + +2004-08-22 Andreas Schwab <schwab@suse.de> + + * cvs-status.el: Require pcvs during byte-compiling for defun-cvs-mode. + +2004-08-22 Masatake YAMATO <jet@gyve.org> + + * cvs-status.el (cvs-status-checkout): New function. + (cvs-status-mode-map): Add a key definition for `cvs-status-checkout'. + +2004-08-21 David Kastrup <dak@gnu.org> + + * net/ange-ftp.el (ange-ftp-hash-entry-exists-p) + (ange-ftp-file-entry-p, ange-ftp-file-symlink-p): Since the code + has been converted to use hashtables, the relation `nil=none' is + no longer valid, as `nil' is not a hashtable. This patch tries to + reduce the number of resulting errors. + +2004-08-21 John Paul Wallington <jpw@gnu.org> + + * subr.el (process-kill-without-query): Made obsolete in + version 21.4, not 21.5. + + * log-edit.el (vc-comment-ring, vc-comment-ring-index) + (vc-previous-comment, vc-next-comment) + (vc-comment-search-reverse, vc-comment-search-forward) + (vc-comment-to-change-log): Likewise. + + * international/latin1-disp.el (latin1-char-displayable-p): Likewise. + +2004-08-21 Peter Seibel <peter@javamonkey.com> (tiny patch) + + * emacs-lisp/cl-indent.el (lisp-indent-defmethod): + Correct indentation of DEFMETHODS with non-standard method + combinations (e.g., PROGN, MIN, MAX). + +2004-08-20 Stefan Monnier <monnier@iro.umontreal.ca> + + * startup.el (normal-top-level-add-subdirs-to-load-path): + Avoid unnecessarily checking system-type. + (normal-top-level): Set TERM to "dumb". Simplify. + + * avoid.el (mouse-avoidance-ignore-p): New fun. + Also ignore switch-frame, select-window, double, and triple clicks. + (mouse-avoidance-banish-hook, mouse-avoidance-exile-hook) + (mouse-avoidance-fancy-hook): Use it. + +2004-08-20 Zoran Milojevic <zoran@sipquest.com> (tiny change) + + * avoid.el (mouse-avoidance-nudge-mouse) + (mouse-avoidance-banish-destination): Stay within the current window + to avoid problems with mouse-autoselect-window. + +2004-08-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * pcvs-parse.el (cvs-parse-table, cvs-parse-commit): Try to adapt to + the newer format of some messages in cvs-1.12.1. + +2004-08-19 Masatake YAMATO <jet@gyve.org> + + * emacs-lisp/elp.el (elp-results-symname-map): New keymap. + (elp-results-jump-to-definition-by-mouse) + (elp-results-jump-to-definition, elp-output-insert-symname): New funs. + (elp-output-result): Use elp-output-insert-symname. + +2004-08-18 Kenichi Handa <handa@m17n.org> + + * language/cyrillic.el: Register koi8-r in + ctext-non-standard-encodings-alist. + ("Cyrillic-KOI8"): Add ctext-non-standard-encoding. + +2004-08-17 Luc Teirlinck <teirllm@auburn.edu> + + * emacs-lisp/copyright.el (copyright-update-year): Delete code + that replaces 20xy with xy. + +2004-08-17 John Paul Wallington <jpw@gnu.org> + + * emacs-lisp/re-builder.el (reb-mode-map): Define within defvar. + (reb-force-update): Doc fix. + +2004-08-16 Richard M. Stallman <rms@gnu.org> + + * progmodes/which-func.el (which-func-update-1): Doc fix. + + * progmodes/sh-script.el (sh-set-shell): Use sh-mode-abbrev-table. + (sh-mode-abbrev-table): New variable. + + * progmodes/compile.el (compilation-mode): Doc fix. + + * emacs-lisp/lisp-mode.el (eval-last-sexp): + Don't cons a new symbol each time. + (eval-last-sexp-fake-value): New variable. + + * emacs-lisp/copyright.el (copyright-years-regexp): New variable. + (copyright-update-year): Detect continuation of list of years. + + * term.el (term-default-fg-color, term-default-bg-color) + (ansi-term-color-vector): Use `unspecified', not nil, as default. + + * imenu.el: Several doc fixes: don't say variables are buffer-local. + +2004-08-16 Davis Herring <herring@lanl.gov> + + * isearch.el (isearch-string, isearch-message-string, isearch-point) + (isearch-success, isearch-forward-flag, isearch-other-end) + (isearch-word, isearch-invalid-regexp, isearch-wrapped) + (isearch-barrier, isearch-within-brackets) + (isearch-case-fold-search): Fix broken `nth'-like calls to `aref'. + +2004-08-16 Kenichi Handa <handa@m17n.org> + + * ps-mule.el (ps-mule-font-info-database): Fix docstring. + +2004-08-15 Kenichi Handa <handa@m17n.org> + + * term/x-win.el (x-selection-value): If utf8 was successful but + ctext was not, use utf8 string. + +2004-08-14 Davis Herring <herring@lanl.gov> + + * isearch.el: Remove accidental changes of March 4. Fix backing + up when a regexp isearch is made more general. Use symbolic + accessor functions for isearch stack frames to make usage clearer. + (search-whitespace-regexp): Made groups in documentation shy (as + is the group in the default value). + (isearch-fallback): New function, addresses problems with regexps + liberalized by `\|', adds support for liberalization by `\}' (the + general repetition construct), and incorporates behavior for + `*'/`?'. + (isearch-}-char): New command, calls `isearch-fallback' with + arguments appropriate to a typed `}'. + (isearch-*-char, isearch-|-char): Now just call `isearch-fallback' + appropriately. + (isearch-mode-map): Bind `}' to `isearch-}-char'. + (isearch-string, isearch-message,string, isearch-point) + (isearch-success, isearch-forward-flag, isearch-other-end) + (isearch-word, isearch-invalid-regexp, isearch-wrapped) + (isearch-barrier, isearch-within-brackets, isearch-case-fold-search): + New inline functions to read fields of a stack frame. + +2004-08-14 Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> (tiny change) + + * battery.el (battery-linux-proc-acpi): Look into battery + directories matching the literal string "CMB", too (required for + Linux kernel version 2.6.7). + +2004-08-14 John Paul Wallington <jpw@gnu.org> + + * cus-start.el (read-file-name-completion-ignore-case): Add. + (blink-cursor-alist): Change version to "21.4". + + * emacs-lisp/bytecomp.el (forward-word): Allow 0 args. + +2004-08-11 Daniel Pfeiffer <occitan@esperanto.org> + + * speedbar.el (speedbar-scan-subdirs): New option. + (speedbar-file-lists): Don't ignore file-name case on Unix and use + dolist. + (speedbar-insert-files-at-point): Take an extra argument and use + it to optionally find out if a subdir is empty. Also unreadable + files don't get expand buttons. + (speedbar-directory): New image (unused pixmap already existed). + (speedbar-expand-image-button-alist): Use it. + +2004-08-11 Martin Stjernholm <bug-cc-mode@gnu.org> + + CC Mode update to 5.30.9: + + * progmodes/cc-defs.el, progmodes/cc-vars.el (c-emacs-features): + Move from cc-vars to cc-defs for dependency reasons. Fix the + POSIX char class test to check that it works in + `skip-chars-(forward|backward)' too. + + * progmodes/cc-align.el (c-lineup-arglist): Fix bug when the + first argument starts with a special brace list. + + * progmodes/cc-engine.el (c-forward-type): Fix promotion bug + when `c-opt-type-concat-key' is used (i.e. in Pike). + + * progmodes/cc-engine.el (c-looking-at-special-brace-list): + Fix bug when the inner char pair doesn't have paren syntax, i.e. "(< + >)". + + * progmodes/cc-align.el (c-lineup-multi-inher): Made it syntactic + whitespace safe. + + * progmodes/cc-engine.el (c-guess-basic-syntax): Fix anchor + position for `arglist-intro', `arglist-cont-nonempty' and + `arglist-close' when there are two arglist open parens on the same + line and there's nothing in front of the first. + + * progmodes/cc-fonts.el (c-basic-matchers-before): Fix font + locking of qualified names in Java, which previously could fontify + common indexing expressions in many cases. The standard Java + naming conventions are used to tell them apart. + + * progmodes/cc-align.el (c-lineup-whitesmith-in-block): + Fix inconsistency wrt opening parens on the first line inside a paren + block. + + * progmodes/cc-defs.el (c-langs-are-parametric): Must be known at + compile time for the sake of `c-major-mode-is'. + + (c-mode-is-new-awk-p): Made it a macro to delay expansion of + `c-major-mode-is' in the event that this is used inside a + `c-lang-defconst'. + + * progmodes/cc-defs.el (c-major-mode-is): Fix expansion inside + `c-lang-defconst' so that it works better with fallback languages. + + * progmodes/cc-defs.el (c-add-language): Fix a typo that caused + it to fail to record the base mode. + + * progmodes/cc-engine.el (c-syntactic-re-search-forward): + Fix bug so that it doesn't go past the closing paren when PAREN-LEVEL + is used. Reordered the syntax checks to get more efficient + skipping in some situations. + + * progmodes/cc-cmds.el (c-electric-brace): Don't trip up on a line + continuation which might precede the newly inserted '{'. + + * progmodes/cc-engine.el (c-syntactic-re-search-forward): + Fix cases where it could loop indefinitely. + + * progmodes/cc-fonts.el (c-font-lock-declarators): Handle array + size specs correctly. Only fontify identifiers in front of '(' + with as functions - don't accept any paren char. Tightened up + initializer skipping to stop before function and class blocks. + + * progmodes/cc-engine.el (c-beginning-of-decl-1): Fix bug where + the point could be left directly after an open paren when finding + the beginning of the first decl in the block. + + * progmodes/cc-engine.el (c-parse-state): Don't use the syntax + table when filtering out legitimate open parens to be recorded. + This could cause cache inconsistencies when e.g. + `c++-template-syntax-table' was temporarily in use. + + * progmodes/cc-engine.el (c-on-identifier) + (c-simple-skip-symbol-backward): Small fix for handling "-" + correctly in `skip-chars-backward'. Affected the operator lfun + syntax in Pike. + + * progmodes/cc-engine.el (c-invalidate-sws-region-after): + Fix bug that could cause an error from `after-change-functions' when + the changed region is at bob. + +2004-08-11 Alan Mackenzie <bug-cc-mode@gnu.org> + + CC Mode update to 5.30.9: + + * progmodes/cc-cmds.el, progmodes/cc-vars.el: Amend doc(-strings) + to say that <TAB> doesn't insert WS into a CPP line. + (c-indent-command, c-tab-always-indent): Amend doc strings. + + * progmodes/cc-styles.el, progmodes/cc-engine.el: Add in two + checks for user errors, thus eliminating cryptic and unhelpful + Emacs error messages. (1) Check the arg to `c-set-style' is a + string. (2) Check that settings to `c-offsets-alist' are not + spuriously quoted. + + * progmodes/cc-cmds.el: (c-electric-brace): Don't delete a comment + which precedes the newly inserted `{'. + +2004-08-10 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.0.44. + + * net/tramp.el (tramp-post-connection): Quote $1 and $2 of shell + function "tramp_file_attributes". Otherwise, file names + containing spaces are misinterpreted. Reported by Magnus Henoch + <mange@freemail.hu>. + (tramp-handle-file-truename): FILENAME must be expanded first. + Otherwise, parameters like "/ssh:deego@gnufans.net:~" will return + obscure results. Reported by D. Goel <deego@gnufans.org>. + (tramp-handle-verify-visited-file-modtime): If file does not + exist, say it is not modified if and only if that agrees with the + buffer's record. Check whether a file is visiting the buffer, or + the buffer has no recorded last modification time. Return t in + case the visiting file doesn't exist. Suggested by Luc Teirlinck + <teirllm@auburn.edu>. + (tramp-handle-write-region): Pass modtime explicitely to + `set-visited-file-modtime', because filename can be different + from (buffer-file-name) if `file-precious-flag' is set. + `set-visited-file-modtime' must be called always when `visit' is t + or a string. Suggested by Luc Teirlinck <teirllm@auburn.edu>. + (tramp-handle-set-visited-file-modtime): If `time-list' is not + nil, don't apply the whole body. If the file doesn't exists, set + modtime to '(-1 65535). Suggested by Luc Teirlinck + <teirllm@auburn.edu>. + +2004-08-09 Luc Teirlinck <teirllm@auburn.edu> + + * help.el (describe-bindings): Doc fix. + + * subr.el (kbd): Doc fix. + +2004-08-08 John Paul Wallington <jpw@gnu.org> + + * ibuffer.el (define-ibuffer-column size): Use `string-to-number' + instead of `string-to-int'. + (define-ibuffer-column mode): Fix indentation. + +2004-08-08 Lars Hansen <larsh@math.ku.dk> + + * wid-edit.el (widget-sexp-validate): Allow whitespace after expression. + +2004-08-08 Luc Teirlinck <teirllm@auburn.edu> + + * subr.el (global-unset-key, local-unset-key): Doc fixes. + + * novice.el (disabled-command-function): New variable renamed from + `disabled-command-hook'. + (disabled-command-hook): Keep the _variable_ as alias for + `disabled-command-function' and make obsolete. + (disabled-command-function): Function renamed from + `disabled-command-hook'. Adapt code to name change of the variable. + +2004-08-07 Satyaki Das <satyaki@theforce.stanford.edu> (tiny change) + + * simple.el (completion-root-regexp): New defvar. + (completion-setup-function): Use it instead of a literal string. + +2004-08-07 John Paul Wallington <jpw@gnu.org> + + * emacs-lisp/re-builder.el (reb-re-syntax): Add `rx' syntax. + (reb-lisp-mode): Require `rx' feature when `re-reb-syntax' is `rx'. + (reb-lisp-syntax-p, reb-change-syntax): `rx' is a Lisp syntax. + (reb-cook-regexp): Call `rx-to-string' when `re-reb-syntax' is `rx'. + +2004-08-05 Katsumi Yamaoka <yamaoka@jpl.org> (tiny change) + + * mail/mail-extr.el (mail-extr-disable-voodoo): New variable. + (mail-extr-voodoo): Check mail-extr-disable-voodoo. + +2004-08-04 Kenichi Handa <handa@m17n.org> + + * international/encoded-kb.el (encoded-kbd-setup-keymap): + Fix previous change. + +2004-08-03 Kenichi Handa <handa@m17n.org> + + * international/encoded-kb.el: The following changes are to + utilize key-translation-map instead of minor mode map. + (encoded-kbd-iso2022-non-ascii-map): Delete it. + (encoded-kbd-coding, encoded-kbd-handle-8bit): Delete them. + (encoded-kbd-last-key): New function. + (encoded-kbd-iso2022-single-shift): New function. + (encoded-kbd-iso2022-designation) + (encoded-kbd-self-insert-iso2022-7bit) + (encoded-kbd-self-insert-iso2022-8bit) + (encoded-kbd-self-insert-sjis, encoded-kbd-self-insert-big5) + (encoded-kbd-self-insert-ccl): Make them suitable for bindings in + key-translation-map. + (encoded-kbd-setup-keymap): Setup key-translation-map. + (saved-key-translation-map): New variable. + (encoded-kbd-mode): Save/restore key-translation-map. Adjusted + for the change of encoded-kbd-setup-keymap. + +2004-08-02 Kim F. Storm <storm@cua.dk> + + * avoid.el (mouse-avoidance-point-position): Use window-inside-edges + and call compute-motion with nil for topos and width to get proper + usable width and height for both window and non-window systems. + + * windmove.el (windmove-coordinates-of-position): Let compute-motion + calculate usable window width and height. + + * window.el (window-buffer-height): Call compute-motion with nil width. + +2004-08-01 David Kastrup <dak@gnu.org> + + * replace.el (query-replace-read-from): + Use `query-replace-compile-replacement'. + (query-replace-compile-replacement): New function. + (query-replace-read-to): Use `query-replace-compile-replacement' + for repeating the last command. + +2004-08-01 John Paul Wallington <jpw@gnu.org> + + * printing.el (toplevel, pr-ps-fast-fire, pr-ps-set-utility) + (pr-ps-set-printer, pr-txt-set-printer, pr-eval-setting-alist) + (pr-switches): Remove period from end of error messages. + + * help-mode.el (help-go-back): Likewise. + + * abbrev.el (only-global-abbrevs): Doc fix. + (edit-abbrevs-map): Define within defvar. + (quietly-read-abbrev-file): Doc fix. + +2004-07-31 Luc Teirlinck <teirllm@auburn.edu> + + * novice.el (enable-command, disable-command): Doc fixes. + + * subr.el (event-modifiers, event-basic-type): Doc fixes. + +2004-07-30 Richard M. Stallman <rms@gnu.org> + + * subr.el (with-local-quit): Doc fix. + +2004-07-30 Luc Teirlinck <teirllm@auburn.edu> + + * international/utf-8.el (utf-translate-cjk-mode): Doc fix. + +2004-07-28 Luc Teirlinck <teirllm@auburn.edu> + + * custom.el (defcustom): Doc fix. + +2004-07-28 Masatake YAMATO <jet@gyve.org> + + * progmodes/etags.el (etags-tags-apropos): Show building progress. + +2004-07-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * imenu.el (imenu-prev-index-position-function) + (imenu-extract-index-name-function, imenu-name-lookup-function) + (imenu--index-alist): Docstring redundancy fix. + +2004-07-25 Lars Hansen <larsh@math.ku.dk> + + * wdired.el (wdired-finish-edit): Require dired-aux before locally + binding dired-backup-overwrite. + +2004-07-25 John Paul Wallington <jpw@gnu.org> + + * subr.el (butlast, event-modifiers, event-basic-type): Doc fixes. + +2004-07-24 Luc Teirlinck <teirllm@auburn.edu> + + * term/tty-colors.el (tty-color-approximate): Doc fix. + + * select.el (x-get-selection, x-set-selection): Doc fixes. + + * frame.el (make-frame): Doc fix. + +2004-07-24 Richard M. Stallman <rms@gnu.org> + + * mail/rmail.el (rmail-mime-charset-pattern): + Don't include semicolon in the charset value. + + * replace.el (occur-next-error): Call set-window-point. + (occur-engine): Handle negative NLINES. + +2004-07-23 Luc Teirlinck <teirllm@auburn.edu> + + * frame.el (modify-all-frames-parameters): Minor doc fix. + (set-frame-configuration): Doc fix. + +2004-07-23 Matt Hodges <matt@stchem.bham.ac.uk> (tiny change) + + * simple.el (completion-setup-function): Compute the common parts + and the first difference place correctly when + partial-completion-mode is on. + +2004-07-22 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * ps-print.el: Doc fix. + (ps-print-version): New version 6.6.5. + (ps-printing-region): Doc fix. + (ps-generate-string-list): Comment fix. + (ps-message-log-max): Code fix. + +2004-07-22 Michael Piotrowski <mxp@dynalabs.de> (tiny change) + + * ps-print.el (ps-begin-file): Improve the DSC compliance of the + generated PostScript. + 2004-08-17 Reiner Steib <Reiner.Steib@gmx.de> * net/tls.el (tls-process-connection-type): Fix docstring. (Sync @@ -22,11 +778,9 @@ 2004-07-20 Richard M. Stallman <rms@gnu.org> - * textmodes/fill.el (fill-comment-paragraph): Handle indent-tabs-mode. - (fill-delete-newlines): Call sentence-end as function. - (fill-nobreak-p, canonically-space-region): Likewise. - (fill-nobreak-p): If this break point is at the end of the line, - don't consider the newline which follows as a reason to return t. + * textmodes/fill.el (fill-nobreak-p): If this break point is + at the end of the line, don't consider the newline which follows + as a reason to return t. 2004-07-19 John Paul Wallington <jpw@gnu.org> @@ -39,8 +793,8 @@ 2004-07-17 Kai Grossjohann <kai.grossjohann@gmx.net> - * net/tramp.el (tramp-handle-verify-visited-file-modtime): New - docstring. From Luc Teirlinck. + * net/tramp.el (tramp-handle-verify-visited-file-modtime): + New docstring. From Luc Teirlinck. 2004-07-17 Luc Teirlinck <teirllm@auburn.edu> diff --git a/lisp/abbrev.el b/lisp/abbrev.el index 3be0014fd0e..3580c136948 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -29,7 +29,7 @@ ;;; Code: (defcustom only-global-abbrevs nil - "*t means user plans to use global abbrevs only. + "Non-nil means user plans to use global abbrevs only. This makes the commands that normally define mode-specific abbrevs define global abbrevs instead." :type 'boolean @@ -59,13 +59,12 @@ to enable or disable Abbrev mode in the current buffer." :group 'abbrev-mode) -(defvar edit-abbrevs-map nil +(defvar edit-abbrevs-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-x\C-s" 'edit-abbrevs-redefine) + (define-key map "\C-c\C-c" 'edit-abbrevs-redefine) + map) "Keymap used in `edit-abbrevs'.") -(if edit-abbrevs-map - nil - (setq edit-abbrevs-map (make-sparse-keymap)) - (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine) - (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine)) (defun kill-all-abbrevs () "Undefine all defined abbrevs." @@ -195,7 +194,7 @@ Optional second argument QUIETLY non-nil means don't display a message." (setq abbrevs-changed nil)) (defun quietly-read-abbrev-file (&optional file) - "Read abbrev definitions from file written with write-abbrev-file. + "Read abbrev definitions from file written with `write-abbrev-file'. Optional argument FILE is the name of the file to read; it defaults to the value of `abbrev-file-name'. Does not display any message." diff --git a/lisp/autorevert.el b/lisp/autorevert.el index ef438eb4b97..ecf768c5732 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -1,6 +1,6 @@ ;;; autorevert.el --- revert buffers when files on disk change -;; Copyright (C) 1997, 1998, 1999, 2001 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2001, 2004 Free Software Foundation, Inc. ;; Author: Anders Lindgren <andersl@andersl.com> ;; Keywords: convenience @@ -421,7 +421,8 @@ This is an internal function used by Auto-Revert Mode." 'no-mini t)) (if auto-revert-tail-mode (auto-revert-tail-handler) - (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)) + (let ((buffer-read-only buffer-read-only)) + (revert-buffer 'ignore-auto 'dont-ask 'preserve-modes))) (when buffer-file-name (when eob (goto-char (point-max))) (dolist (window eoblist) diff --git a/lisp/avoid.el b/lisp/avoid.el index 5a5a09622cd..b5e7d1f9b62 100644 --- a/lisp/avoid.el +++ b/lisp/avoid.el @@ -1,6 +1,6 @@ ;;; avoid.el --- make mouse pointer stay out of the way of editing -;;; Copyright (C) 1993, 1994, 2000 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 2000, 2004 Free Software Foundation, Inc. ;; Author: Boris Goldowsky <boris@gnu.org> ;; Keywords: mouse @@ -52,7 +52,7 @@ ;; ;; Bugs / Warnings / To-Do: ;; -;; - Using this code does slow emacs down. "banish" mode shouldn't +;; - Using this code does slow Emacs down. "banish" mode shouldn't ;; be too bad, and on my workstation even "animate" is reasonable. ;; ;; - It ought to find out where any overlapping frames are and avoid them, @@ -96,7 +96,7 @@ use either \\[customize] or the function `mouse-avoidance-mode'." (defcustom mouse-avoidance-nudge-dist 15 "*Average distance that mouse will be moved when approached by cursor. -Only applies in mouse-avoidance-mode `jump' and its derivatives. +Only applies in Mouse-Avoidance mode `jump' and its derivatives. For best results make this larger than `mouse-avoidance-threshold'." :type 'integer :group 'avoid) @@ -137,17 +137,17 @@ Only applies in mouse-avoidance-modes `animate' and `jump'." (defun mouse-avoidance-point-position () "Return the position of point as (FRAME X . Y). -Analogous to mouse-position." +Analogous to `mouse-position'." (let* ((w (selected-window)) - (edges (window-edges w)) + (edges (window-inside-edges w)) (list (compute-motion (max (window-start w) (point-min)) ; start pos ;; window-start can be < point-min if the ;; latter has changed since the last redisplay '(0 . 0) ; start XY (point) ; stop pos - (cons (window-width) (window-height)); stop XY: none - (1- (window-width)) ; width + nil ; stop XY: none + nil ; width (cons (window-hscroll w) 0) ; 0 may not be right? (selected-window)))) ;; compute-motion returns (pos HPOS VPOS prevhpos contin) @@ -194,10 +194,11 @@ Acceptable distance is defined by `mouse-avoidance-threshold'." mouse-avoidance-threshold)))))) (defun mouse-avoidance-banish-destination () - "The position to which mouse-avoidance-mode `banish' moves the mouse. + "The position to which Mouse-Avoidance mode `banish' moves the mouse. You can redefine this if you want the mouse banished to a different corner." - (cons (1- (frame-width)) - 0)) + (let* ((pos (window-edges))) + (cons (- (nth 2 pos) 2) + (nth 1 pos)))) (defun mouse-avoidance-banish-mouse () ;; Put the mouse pointer in the upper-right corner of the current frame. @@ -225,22 +226,27 @@ You can redefine this if you want the mouse banished to a different corner." (t 0)))) (defun mouse-avoidance-nudge-mouse () - ;; Push the mouse a little way away, possibly animating the move + ;; Push the mouse a little way away, possibly animating the move. ;; For these modes, state keeps track of the total offset that we've ;; accumulated, and tries to keep it close to zero. (let* ((cur (mouse-position)) (cur-frame (car cur)) (cur-pos (cdr cur)) + (pos (window-edges)) + (wleft (pop pos)) + (wtop (pop pos)) + (wright (pop pos)) + (wbot (pop pos)) (deltax (mouse-avoidance-delta (car cur-pos) (- (random mouse-avoidance-nudge-var) (car mouse-avoidance-state)) mouse-avoidance-nudge-dist mouse-avoidance-nudge-var - 0 (frame-width))) + wleft (1- wright))) (deltay (mouse-avoidance-delta (cdr cur-pos) (- (random mouse-avoidance-nudge-var) (cdr mouse-avoidance-state)) mouse-avoidance-nudge-dist mouse-avoidance-nudge-var - 0 (frame-height)))) + wtop (1- wbot)))) (setq mouse-avoidance-state (cons (+ (car mouse-avoidance-state) deltax) (+ (cdr mouse-avoidance-state) deltay))) @@ -277,33 +283,34 @@ redefine this function to suit your own tastes." (nth (random mouse-avoidance-n-pointer-shapes) mouse-avoidance-pointer-shapes)) +(defun mouse-avoidance-ignore-p () + (let ((mp (mouse-position))) + (or executing-kbd-macro ; don't check inside macro + (null (cadr mp)) ; don't move unless in an Emacs frame + (not (eq (car mp) (selected-frame))) + ;; Don't do anything if last event was a mouse event. + ;; FIXME: this code fails in the case where the mouse was moved + ;; since the last key-press but without generating any event. + (and (consp last-input-event) + (symbolp (car last-input-event)) + (let ((modifiers (event-modifiers (car last-input-event)))) + (or (memq (car last-input-event) + '(mouse-movement scroll-bar-movement + select-window switch-frame)) + (memq 'click modifiers) + (memq 'double modifiers) + (memq 'triple modifiers) + (memq 'drag modifiers) + (memq 'down modifiers))))))) + (defun mouse-avoidance-banish-hook () - (if (and (not executing-kbd-macro) ; don't check inside macro - (cadr (mouse-position)) ; don't move unless in an Emacs frame - ;; Don't do anything if last event was a mouse event. - (not (and (consp last-input-event) - (symbolp (car last-input-event)) - (let ((modifiers (event-modifiers (car last-input-event)))) - (or (memq (car last-input-event) - '(mouse-movement scroll-bar-movement)) - (memq 'click modifiers) - (memq 'drag modifiers) - (memq 'down modifiers)))))) + (if (not (mouse-avoidance-ignore-p)) (mouse-avoidance-banish-mouse))) (defun mouse-avoidance-exile-hook () ;; For exile mode, the state is nil when the mouse is in its normal ;; position, and set to the old mouse-position when the mouse is in exile. - (if (and (not executing-kbd-macro) - ;; Don't do anything if last event was a mouse event. - (not (and (consp last-input-event) - (symbolp (car last-input-event)) - (let ((modifiers (event-modifiers (car last-input-event)))) - (or (memq (car last-input-event) - '(mouse-movement scroll-bar-movement)) - (memq 'click modifiers) - (memq 'drag modifiers) - (memq 'down modifiers)))))) + (if (not (mouse-avoidance-ignore-p)) (let ((mp (mouse-position))) (cond ((and (not mouse-avoidance-state) (mouse-avoidance-too-close-p mp)) @@ -321,16 +328,7 @@ redefine this function to suit your own tastes." (defun mouse-avoidance-fancy-hook () ;; Used for the "fancy" modes, ie jump et al. - (if (and (not executing-kbd-macro) ; don't check inside macro - ;; Don't do anything if last event was a mouse event. - (not (and (consp last-input-event) - (symbolp (car last-input-event)) - (let ((modifiers (event-modifiers (car last-input-event)))) - (or (memq (car last-input-event) - '(mouse-movement scroll-bar-movement)) - (memq 'click modifiers) - (memq 'drag modifiers) - (memq 'down modifiers))))) + (if (and (not (mouse-avoidance-ignore-p)) (mouse-avoidance-too-close-p (mouse-position))) (let ((old-pos (mouse-position))) (mouse-avoidance-nudge-mouse) @@ -416,5 +414,5 @@ definition of \"random distance\".)" (if mouse-avoidance-mode (mouse-avoidance-mode mouse-avoidance-mode)) -;;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800 +;; arch-tag: 64ad4ef8-a870-4183-8d96-3aa93b7a6800 ;;; avoid.el ends here diff --git a/lisp/battery.el b/lisp/battery.el index 73d78067571..3b44ff891f9 100644 --- a/lisp/battery.el +++ b/lisp/battery.el @@ -290,7 +290,7 @@ The following %-sequences are provided: nil t) (setq low (+ (or low 0) (string-to-int (match-string 1)))))))) - (directory-files "/proc/acpi/battery/" t "BAT"))) + (directory-files "/proc/acpi/battery/" t "\\(BAT\\|CMB\\)"))) (and capacity rate (setq minutes (if (zerop rate) 0 (floor (* (/ (float (if (string= charging-state diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 8a667b91de4..3a850717298 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -45,6 +45,7 @@ (timezone-make-date-arpa-standard date))) (error (error "Invalid date: %s" date)))) +;;;###autoload (defun time-to-seconds (time) "Convert time value TIME to a floating point number. You can use `float-time' instead." diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 5e237cd0db7..c9ce8f8474c 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -121,6 +121,7 @@ (const :tag "always" t))) ;; fileio.c (insert-default-directory minibuffer boolean) + (read-file-name-completion-ignore-case minibuffer boolean "21.4") ;; fns.c (use-dialog-box menu boolean "21.1") (use-file-dialog menu boolean "21.4") @@ -264,7 +265,7 @@ :format "%v") (other :tag "Unlimited" t))) (unibyte-display-via-language-environment mule boolean) - (blink-cursor-alist cursor alist "21.5") + (blink-cursor-alist cursor alist "21.4") ;; xfaces.c (scalable-fonts-allowed display boolean) ;; xfns.c diff --git a/lisp/custom.el b/lisp/custom.el index e86308c95e7..2ddd7ceb943 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -246,6 +246,13 @@ The following keywords are meaningful: Specifies that SYMBOL should be set after the list of variables VARIABLES when both have been customized. +If SYMBOL has a local binding, then this form affects the local +binding. This is normally not what you want. Thus, if you need +to load a file defining variables with this form, or with +`defvar' or `defconst', you should always load that file +_outside_ any bindings for these variables. \(`defvar' and +`defconst' behave similarly in this respect.) + Read the section about customization in the Emacs Lisp manual for more information." ;; It is better not to use backquote in this file, diff --git a/lisp/cvs-status.el b/lisp/cvs-status.el index b03182d87e4..419f8567a90 100644 --- a/lisp/cvs-status.el +++ b/lisp/cvs-status.el @@ -31,6 +31,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'pcvs)) (require 'pcvs-util) ;;; @@ -48,7 +49,8 @@ ("\M-n" . cvs-status-next) ("\M-p" . cvs-status-prev) ("t" . cvs-status-cvstrees) - ("T" . cvs-status-trees)) + ("T" . cvs-status-trees) + (">" . cvs-status-checkout)) "CVS-Status' keymap." :group 'cvs-status :inherit 'cvs-mode-map) @@ -464,6 +466,25 @@ Optional prefix ARG chooses between two representations." ;;(sit-for 0) )))))) +(defun-cvs-mode (cvs-status-checkout . NOARGS) (dir) + "Run cvs-checkout against the tag under the point. +The files are stored to DIR." + (interactive + (let* ((module (cvs-get-module)) + (branch (cvs-prefix-get 'cvs-branch-prefix)) + (prompt (format "CVS Checkout Directory for `%s%s': " + module + (if branch (format "(branch: %s)" branch) + "")))) + (list + (read-directory-name prompt + nil default-directory nil)))) + (let ((modules (cvs-string->strings (cvs-get-module))) + (flags (cvs-add-branch-prefix + (cvs-flags-query 'cvs-checkout-flags "cvs checkout flags"))) + (cvs-cvsroot (cvs-get-cvsroot))) + (cvs-checkout modules dir flags))) + (defun cvs-tree-tags-insert (tags prev) (when tags (let* ((tag (car tags)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index a4ae751cab7..0a12f6fae9f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2900,7 +2900,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-defop-compiler char-after 0-1) (byte-defop-compiler set-buffer 1) ;;(byte-defop-compiler set-mark 1) ;; obsolete -(byte-defop-compiler19 forward-word 1) +(byte-defop-compiler19 forward-word 0-1) (byte-defop-compiler19 char-syntax 1) (byte-defop-compiler19 nreverse 1) (byte-defop-compiler19 car-safe 1) diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index c5e13a4c00f..a203155673c 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -458,7 +458,7 @@ If nil, indent backquoted lists as data, i.e., like quoted lists." (forward-char 1) (forward-sexp 3) (backward-sexp) - (looking-at ":"))) + (looking-at ":\\|\\sw+"))) '(4 4 (&whole 4 &rest 4) &body) (get 'defun 'common-lisp-indent-function)) path state indent-point sexp-column normal-indent)) diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 6a95c60f859..3d160f54606 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -54,6 +54,13 @@ The second \\( \\) construct must match the years." :group 'copyright :type 'regexp) +(defcustom copyright-years-regexp + "\\(\\s *\\)\\([1-9]\\([-0-9, ';/*%#\n\t]\\|\\s<\\|\\s>\\)*[0-9]+\\)" + "*Match additional copyright notice years. +The second \\( \\) construct must match the years." + :group 'copyright + :type 'regexp) + (defcustom copyright-query 'function "*If non-nil, ask user before changing copyright. @@ -77,6 +84,23 @@ When this is `function', only ask when called non-interactively." (defun copyright-update-year (replace noquery) (when (re-search-forward copyright-regexp (+ (point) copyright-limit) t) + ;; If the years are continued onto multiple lined + ;; that are marked as comments, skip to the end of the years anyway. + (while (save-excursion + (and (eq (following-char) ?,) + (progn (forward-char 1) t) + (progn (skip-chars-forward " \t") (eolp)) + comment-start-skip + (save-match-data + (forward-line 1) + (and (looking-at comment-start-skip) + (goto-char (match-end 0)))) + (save-match-data + (looking-at copyright-years-regexp)))) + (forward-line 1) + (re-search-forward comment-start-skip) + (re-search-forward copyright-years-regexp)) + ;; Note that `current-time-string' isn't locale-sensitive. (setq copyright-current-year (substring (current-time-string) -4)) (unless (string= (buffer-substring (- (match-end 2) 2) (match-end 2)) @@ -100,26 +124,6 @@ When this is `function', only ask when called non-interactively." (eq (char-after (+ (point) size -2)) ?-))) ;; This is a range so just replace the end part. (delete-char size) - ;; Detect if this is using the following shorthand: - ;; (C) 1993, 94, 95, 1998, 2000, 01, 02, 2003 - (if (and - ;; Check that the last year was 4-chars and same century. - (eq size -4) - (equal (buffer-substring (- (point) 4) (- (point) 2)) - (substring copyright-current-year 0 2)) - ;; Check that there are 2-char years as well. - (save-excursion - (re-search-backward "[^0-9][0-9][0-9][^0-9]" - (line-beginning-position) t)) - ;; Make sure we don't remove the first century marker. - (save-excursion - (forward-char size) - (re-search-backward - (concat (buffer-substring (point) (+ (point) 2)) - "[0-9][0-9]") - (line-beginning-position) t))) - ;; Remove the century marker of the last entry. - (delete-region (- (point) 4) (- (point) 2))) ;; Insert a comma with the preferred number of spaces. (insert (save-excursion diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el index 44400dcaa2c..f8d41f200d2 100644 --- a/lisp/emacs-lisp/elp.el +++ b/lisp/emacs-lisp/elp.el @@ -513,7 +513,7 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." (numberp elp-report-limit) (< cc elp-report-limit)) nil - (insert symname) + (elp-output-insert-symname symname) (insert-char 32 (+ elp-field-len (- (length symname)) 2)) ;; print stuff out, formatting it nicely (insert callcnt) @@ -525,6 +525,32 @@ original definition, use \\[elp-restore-function] or \\[elp-restore-all]." (insert atstr)) (insert "\n")))) +(defvar elp-results-symname-map + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] 'elp-results-jump-to-definition-by-mouse) + (define-key map "\C-m" 'elp-results-jump-to-definition) + map) + "Keymap used on the function name column." ) + +(defun elp-results-jump-to-definition-by-mouse (event) + "Jump to the definition of the function under the place specified by EVENT." + (interactive "e") + (posn-set-point (event-end event)) + (elp-results-jump-to-definition)) + +(defun elp-results-jump-to-definition () + "Jump to the definition of the function under the point." + (interactive) + (find-function (get-text-property (point) 'elp-symname))) + +(defun elp-output-insert-symname (symname) + ;; Insert SYMNAME with text properties. + (insert (propertize symname + 'elp-symname (intern symname) + 'keymap elp-results-symname-map + 'mouse-face 'highlight + 'help-echo (substitute-command-keys "\\{elp-results-symname-map}")))) + ;;;###autoload (defun elp-results () "Display current profiling results. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index d471ad79538..e2aac327ddc 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -363,7 +363,7 @@ if that value is non-nil." (when (stringp default) (if (string-match ":+" default) (substring default (match-end 0)) - default)))) + default)))) ;; Used in old LispM code. (defalias 'common-lisp-mode 'lisp-mode) @@ -459,21 +459,37 @@ alternative printed representations that can be displayed." If CHAR is not a character, return nil." (and (integerp char) (eventp char) - (let ((c (event-basic-type char))) - (concat - "?" - (mapconcat - (lambda (modif) - (cond ((eq modif 'super) "\\s-") - (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) - (event-modifiers char) "") - (cond - ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c)) - ((eq c 127) "\\C-?") - (t - (condition-case nil - (string c) - (error nil)))))))) + (let ((c (event-basic-type char)) + (mods (event-modifiers char)) + string) + ;; Prevent ?A from turning into ?\S-a. + (if (and (memq 'shift mods) + (zerop (logand char ?\S-\^@)) + (not (let ((case-fold-search nil)) + (char-equal c (upcase c))))) + (setq c (upcase c) mods nil)) + ;; What string are we considering using? + (condition-case nil + (setq string + (concat + "?" + (mapconcat + (lambda (modif) + (cond ((eq modif 'super) "\\s-") + (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-)))) + mods "") + (cond + ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c)) + ((eq c 127) "\\C-?") + (t + (string c))))) + (error nil)) + ;; Verify the string reads a CHAR, not to some other character. + ;; If it doesn't, return nil instead. + (and string + (= (car (read-from-string string)) char) + string)))) + (defun eval-last-sexp-1 (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. @@ -555,13 +571,15 @@ With argument, print output into current buffer." )))) +(defvar eval-last-sexp-fake-value (make-symbol "t")) + (defun eval-last-sexp (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. Interactively, with prefix argument, print output into current buffer." (interactive "P") (if (null eval-expression-debug-on-error) (eval-last-sexp-1 eval-last-sexp-arg-internal) - (let ((old-value (make-symbol "t")) new-value value) + (let ((old-value eval-last-sexp-fake-value) new-value value) (let ((debug-on-error old-value)) (setq value (eval-last-sexp-1 eval-last-sexp-arg-internal)) (setq new-value debug-on-error)) diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 25fde86cd96..46d3d2625a1 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -176,7 +176,8 @@ If variable `beginning-of-defun-function' is non-nil, its value is called as a function to find the defun's beginning." (interactive "p") (and (eq this-command 'beginning-of-defun) - (or (eq last-command 'beginning-of-defun) (push-mark))) + (or inhibit-mark-movement (eq last-command 'beginning-of-defun) + (push-mark))) (and (beginning-of-defun-raw arg) (progn (beginning-of-line) t))) @@ -226,7 +227,8 @@ If variable `end-of-defun-function' is non-nil, its value is called as a function to find the defun's end." (interactive "p") (and (eq this-command 'end-of-defun) - (or (eq last-command 'end-of-defun) (push-mark))) + (or inhibit-mark-movement (eq last-command 'end-of-defun) + (push-mark))) (if (or (null arg) (= arg 0)) (setq arg 1)) (if end-of-defun-function (if (> arg 0) diff --git a/lisp/emacs-lisp/re-builder.el b/lisp/emacs-lisp/re-builder.el index c6112c4a105..77a12167c30 100644 --- a/lisp/emacs-lisp/re-builder.el +++ b/lisp/emacs-lisp/re-builder.el @@ -45,7 +45,7 @@ ;; call `reb-force-update' ("\C-c\C-u") which should reveal the error. ;; The target buffer can be changed with `reb-change-target-buffer' -;; ("\C-c\C-b"). Changing the target buffer automatically removes +;; ("\C-c\C-b"). Changing the target buffer automatically removes ;; the overlays from the old buffer and displays the new one in the ;; target window. @@ -135,6 +135,7 @@ Can either be `read', `string', `sregex' or `lisp-re'." (const :tag "String syntax" string) (const :tag "`sregex' syntax" sregex) (const :tag "`lisp-re' syntax" lisp-re) + (const :tag "`rx' syntax" rx) (value: string))) (defcustom reb-auto-match-limit 200 @@ -228,22 +229,20 @@ Except for Lisp syntax this is the same as `reb-regexp'.") "Buffer to use for the RE Builder.") ;; Define the local "\C-c" keymap -(defvar reb-mode-map nil +(defvar reb-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c\C-c" 'reb-toggle-case) + (define-key map "\C-c\C-q" 'reb-quit) + (define-key map "\C-c\C-w" 'reb-copy) + (define-key map "\C-c\C-s" 'reb-next-match) + (define-key map "\C-c\C-r" 'reb-prev-match) + (define-key map "\C-c\C-i" 'reb-change-syntax) + (define-key map "\C-c\C-e" 'reb-enter-subexp-mode) + (define-key map "\C-c\C-b" 'reb-change-target-buffer) + (define-key map "\C-c\C-u" 'reb-force-update) + map) "Keymap used by the RE Builder.") -(if (not reb-mode-map) - (progn - (setq reb-mode-map (make-sparse-keymap)) - (define-key reb-mode-map "\C-c\C-c" 'reb-toggle-case) - (define-key reb-mode-map "\C-c\C-q" 'reb-quit) - (define-key reb-mode-map "\C-c\C-w" 'reb-copy) - (define-key reb-mode-map "\C-c\C-s" 'reb-next-match) - (define-key reb-mode-map "\C-c\C-r" 'reb-prev-match) - (define-key reb-mode-map "\C-c\C-i" 'reb-change-syntax) - (define-key reb-mode-map "\C-c\C-e" 'reb-enter-subexp-mode) - (define-key reb-mode-map "\C-c\C-b" 'reb-change-target-buffer) - (define-key reb-mode-map "\C-c\C-u" 'reb-force-update))) - (defun reb-mode () "Major mode for interactively building Regular Expressions. \\{reb-mode-map}" @@ -261,7 +260,9 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (cond ((eq reb-re-syntax 'lisp-re) ; Pull in packages (require 'lisp-re)) ; as needed ((eq reb-re-syntax 'sregex) ; sregex is not autoloaded - (require 'sregex))) ; right now.. + (require 'sregex)) ; right now.. + ((eq reb-re-syntax 'rx) ; rx-to-string is autoloaded + (require 'rx))) ; require rx anyway (reb-mode-common)) ;; Use the same "\C-c" keymap as `reb-mode' and use font-locking from @@ -320,7 +321,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (defsubst reb-lisp-syntax-p () "Return non-nil if RE Builder uses a Lisp syntax." - (memq reb-re-syntax '(lisp-re sregex))) + (memq reb-re-syntax '(lisp-re sregex rx))) (defmacro reb-target-binding (symbol) "Return binding for SYMBOL in the RE Builder target buffer." @@ -364,7 +365,7 @@ Except for Lisp syntax this is the same as `reb-regexp'.") (reb-update-modestring)))) (defun reb-force-update () - "Forces an update in the RE Builder target window without a match limit." + "Force an update in the RE Builder target window without a match limit." (interactive) (let ((reb-auto-match-limit nil)) @@ -466,10 +467,10 @@ Optional argument SYNTAX must be specified if called non-interactively." (list (intern (completing-read "Select syntax: " (mapcar (lambda (el) (cons (symbol-name el) 1)) - '(read string lisp-re sregex)) + '(read string lisp-re sregex rx)) nil t (symbol-name reb-re-syntax))))) - (if (memq syntax '(read string lisp-re sregex)) + (if (memq syntax '(read string lisp-re sregex rx)) (let ((buffer (get-buffer reb-buffer))) (setq reb-re-syntax syntax) (if buffer @@ -604,6 +605,8 @@ optional fourth argument FORCE is non-nil." (lre-compile-string (eval (car (read-from-string re))))) ((eq reb-re-syntax 'sregex) (apply 'sregex (eval (car (read-from-string re))))) + ((eq reb-re-syntax 'rx) + (rx-to-string (eval (car (read-from-string re))))) (t re))) (defun reb-update-regexp () @@ -670,7 +673,7 @@ If SUBEXP is non-nil mark only the corresponding sub-expressions." (overlay-put overlay 'priority i))) (setq i (1+ i)))))) (let ((count (if subexp submatches matches))) - (message"%s %smatch%s%s" + (message "%s %smatch%s%s" (if (= 0 count) "No" (int-to-string count)) (if subexp "subexpression " "") (if (= 1 count) "" "es") diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index b39945c7712..fb3c537936f 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -141,30 +141,39 @@ ;; completely separate set of "rectangle commands" [C-x r ...] on the ;; region to copy, kill, fill a.s.o. the virtual rectangle. ;; -;; cua-mode's superior rectangle support is based on using a true visual -;; representation of the selected rectangle. To start a rectangle, use -;; [S-return] and extend it using the normal movement keys (up, down, -;; left, right, home, end, C-home, C-end). Once the rectangle has the -;; desired size, you can cut or copy it using C-x and C-c (or C-w and M-w), -;; and you can subsequently insert it - as a rectangle - using C-v (or -;; C-y). So the only new command you need to know to work with -;; cua-mode rectangles is S-return! +;; cua-mode's superior rectangle support uses a true visual +;; representation of the selected rectangle, i.e. it highlights the +;; actual part of the buffer that is currently selected as part of the +;; rectangle. Unlike emacs' traditional rectangle commands, the +;; selected rectangle always as straight left and right edges, even +;; when those are in the middle of a TAB character or beyond the end +;; of the current line. And it does this without actually modifying +;; the buffer contents (it uses display overlays to visualize the +;; virtual dimensions of the rectangle). +;; +;; This means that cua-mode's rectangles are not limited to the actual +;; contents of the buffer, so if the cursor is currently at the end of a +;; short line, you can still extend the rectangle to include more columns +;; of longer lines in the same rectangle. And you can also have the +;; left edge of a rectangle start in the middle of a TAB character. +;; Sounds strange? Try it! +;; +;; To start a rectangle, use [S-return] and extend it using the normal +;; movement keys (up, down, left, right, home, end, C-home, +;; C-end). Once the rectangle has the desired size, you can cut or +;; copy it using C-x and C-c (or C-w and M-w), and you can +;; subsequently insert it - as a rectangle - using C-v (or C-y). So +;; the only new command you need to know to work with cua-mode +;; rectangles is S-return! ;; ;; Normally, when you paste a rectangle using C-v (C-y), each line of ;; the rectangle is inserted into the existing lines in the buffer. ;; If overwrite-mode is active when you paste a rectangle, it is ;; inserted as normal (multi-line) text. ;; -;; Furthermore, cua-mode's rectangles are not limited to the actual -;; contents of the buffer, so if the cursor is currently at the end of a -;; short line, you can still extend the rectangle to include more columns -;; of longer lines in the same rectangle. Sounds strange? Try it! -;; -;; You can enable padding for just this rectangle by pressing [M-p]; -;; this works like entering `picture-mode' where the tabs and spaces -;; are automatically converted/inserted to make the rectangle truly -;; rectangular. Or you can do it for all rectangles by setting the -;; `cua-auto-expand-rectangles' variable. +;; If you prefer the traditional rectangle marking (i.e. don't want +;; straight edges), [M-p] toggles this for the current rectangle, +;; or you can customize cua-virtual-rectangle-edges. ;; And there's more: If you want to extend or reduce the size of the ;; rectangle in one of the other corners of the rectangle, just use @@ -204,8 +213,8 @@ ;; a supplied format string (prompt) ;; [M-o] opens the rectangle by moving the highlighted text to the ;; right of the rectangle and filling the rectangle with blanks. -;; [M-p] toggles rectangle padding, i.e. insert tabs and spaces to -;; make rectangles truly rectangular +;; [M-p] toggles virtual straight rectangle edges +;; [M-P] inserts tabs and spaces (padding) to make real straight edges ;; [M-q] performs text filling on the rectangle ;; [M-r] replaces REGEXP (prompt) by STRING (prompt) in rectangle ;; [M-R] reverse the lines in the rectangle @@ -347,14 +356,27 @@ managers, so try setting this to nil, if prefix override doesn't work." ;;; Rectangle Customization -(defcustom cua-auto-expand-rectangles nil - "*If non-nil, rectangles are padded with spaces to make straight edges. -This implies modifying buffer contents by expanding tabs and inserting spaces. -Consequently, this is inhibited in read-only buffers. -Can be toggled by [M-p] while the rectangle is active," +(defcustom cua-virtual-rectangle-edges t + "*If non-nil, rectangles have virtual straight edges. +Note that although rectangles are always DISPLAYED with straight edges, the +buffer is NOT modified, until you execute a command that actually modifies it. +\[M-p] toggles this feature when a rectangle is active." :type 'boolean :group 'cua) +(defcustom cua-auto-tabify-rectangles 1000 + "*If non-nil, automatically tabify after rectangle commands. +This basically means that `tabify' is applied to all lines that +are modified by inserting or deleting a rectangle. If value is +an integer, cua will look for existing tabs in a region around +the rectangle, and only do the conversion if any tabs are already +present. The number specifies then number of characters before +and after the region marked by the rectangle to search." + :type '(choice (number :tag "Auto detect (limit)") + (const :tag "Disabled" nil) + (other :tag "Enabled" t)) + :group 'cua) + (defcustom cua-enable-rectangle-auto-help t "*If non-nil, automatically show help for region, rectangle and global mark." :type 'boolean @@ -412,7 +434,6 @@ Can be toggled by [M-p] while the rectangle is active," (frame-parameter nil 'cursor-color) "red") "Normal (non-overwrite) cursor color. -Also used to indicate that rectangle padding is not in effect. Default is to load cursor color from initial or default frame parameters. If the value is a COLOR name, then only the `cursor-color' attribute will be @@ -462,7 +483,6 @@ a cons (TYPE . COLOR), then both properties are affected." (defcustom cua-overwrite-cursor-color "yellow" "*Cursor color used when overwrite mode is set, if non-nil. -Also used to indicate that rectangle padding is in effect. Only used when `cua-enable-cursor-indications' is non-nil. If the value is a COLOR name, then only the `cursor-color' attribute will be @@ -806,7 +826,8 @@ If global mark is active, copy from register or one character." (interactive "P") (setq arg (cua--prefix-arg arg)) (let ((regtxt (and cua--register (get-register cua--register))) - (count (prefix-numeric-value arg))) + (count (prefix-numeric-value arg)) + paste-column paste-lines) (cond ((and cua--register (not regtxt)) (message "Nothing in register %c" cua--register)) @@ -825,7 +846,12 @@ If global mark is active, copy from register or one character." ;; the same region that we are going to delete. ;; That would make yank a no-op. (if cua--rectangle - (cua--delete-rectangle) + (progn + (goto-char (min (mark) (point))) + (setq paste-column (cua--rectangle-left)) + (setq paste-lines (cua--delete-rectangle)) + (if (= paste-lines 1) + (setq paste-lines nil))) ;; paste all (if (string= (buffer-substring (point) (mark)) (car kill-ring)) (current-kill 1)) @@ -843,7 +869,8 @@ If global mark is active, copy from register or one character." (setq this-command 'cua--paste-rectangle) (undo-boundary) (setq buffer-undo-list (cons pt buffer-undo-list))) - (cua--insert-rectangle (cdr cua--last-killed-rectangle)) + (cua--insert-rectangle (cdr cua--last-killed-rectangle) + nil paste-column paste-lines) (if arg (goto-char pt)))) (t (yank arg))))))) @@ -1033,9 +1060,7 @@ If ARG is the atom `-', scroll upward by nearly full screen." ((and buffer-read-only cua-read-only-cursor-color) cua-read-only-cursor-color) - ((and cua-overwrite-cursor-color - (or overwrite-mode - (and cua--rectangle (cua--rectangle-padding)))) + ((and cua-overwrite-cursor-color overwrite-mode) cua-overwrite-cursor-color) (t cua-normal-cursor-color))) (color (if (consp cursor) (cdr cursor) cursor)) diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 965fe63bced..3270b7fd62c 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -44,10 +44,10 @@ (require 'rect) ;; If non-nil, restrict current region to this rectangle. -;; Value is a vector [top bot left right corner ins pad select]. +;; Value is a vector [top bot left right corner ins virt select]. ;; CORNER specifies currently active corner 0=t/l 1=t/r 2=b/l 3=b/r. ;; INS specifies whether to insert on left(nil) or right(t) side. -;; If PAD is non-nil, tabs are converted to spaces when necessary. +;; If VIRT is non-nil, virtual straight edges are enabled. ;; If SELECT is a regexp, only lines starting with that regexp are affected.") (defvar cua--rectangle nil) (make-variable-buffer-local 'cua--rectangle) @@ -65,6 +65,12 @@ (defvar cua--rectangle-overlays nil) (make-variable-buffer-local 'cua--rectangle-overlays) +(defvar cua--overlay-keymap + (let ((map (make-sparse-keymap))) + (define-key map "\r" 'cua-rotate-rectangle))) + +(defvar cua--virtual-edges-debug nil) + ;; Per-buffer CUA mode undo list. (defvar cua--undo-list nil) (make-variable-buffer-local 'cua--undo-list) @@ -97,7 +103,7 @@ Knows about CUA rectangle highlighting in addition to standard undo." (defvar cua--tidy-undo-counter 0 "Number of times `cua--tidy-undo-lists' have run successfully.") -;; Clean out danling entries from cua's undo list. +;; Clean out dangling entries from cua's undo list. ;; Since this list contains pointers into the standard undo list, ;; such references are only meningful as undo information if the ;; corresponding entry is still on the standard undo list. @@ -203,11 +209,11 @@ Knows about CUA rectangle highlighting in addition to standard undo." (aref cua--rectangle 5)) (cua--rectangle-left)))) -(defun cua--rectangle-padding (&optional set val) - ;; Current setting of rectangle padding +(defun cua--rectangle-virtual-edges (&optional set val) + ;; Current setting of rectangle virtual-edges (if set (aset cua--rectangle 6 val)) - (and (not buffer-read-only) + (and ;(not buffer-read-only) (aref cua--rectangle 6))) (defun cua--rectangle-restriction (&optional val bounded negated) @@ -226,7 +232,7 @@ Knows about CUA rectangle highlighting in addition to standard undo." (if (< (cua--rectangle-bot) (cua--rectangle-top)) (message "rectangle bot < top"))) -(defun cua--rectangle-get-corners (&optional pad) +(defun cua--rectangle-get-corners () ;; Calculate the rectangular region represented by point and mark, ;; putting start in the upper left corner and end in the ;; bottom right corner. @@ -245,12 +251,12 @@ Knows about CUA rectangle highlighting in addition to standard undo." (setq r (1- r))) (setq l (prog1 r (setq r l))) (goto-char top) - (move-to-column l pad) + (move-to-column l) (setq top (point)) (goto-char bot) - (move-to-column r pad) + (move-to-column r) (setq bot (point)))) - (vector top bot l r corner 0 pad nil))) + (vector top bot l r corner 0 cua-virtual-rectangle-edges nil))) (defun cua--rectangle-set-corners () ;; Set mark and point in opposite corners of current rectangle. @@ -269,24 +275,31 @@ Knows about CUA rectangle highlighting in addition to standard undo." (setq pp (cua--rectangle-bot) pc (cua--rectangle-right) mp (cua--rectangle-top) mc (cua--rectangle-left)))) (goto-char mp) - (move-to-column mc (cua--rectangle-padding)) + (move-to-column mc) (set-mark (point)) (goto-char pp) - (move-to-column pc (cua--rectangle-padding)))) + ;; Move cursor inside rectangle, except if char at rigth edge is a tab. + (if (and (if (cua--rectangle-right-side) + (and (= (move-to-column pc) (- pc tab-width)) + (not (eolp))) + (> (move-to-column pc) pc)) + (not (bolp))) + (backward-char 1)) + )) ;;; Rectangle resizing -(defun cua--forward-line (n pad) +(defun cua--forward-line (n) ;; Move forward/backward one line. Returns t if movement. - (if (or (not pad) (< n 0)) - (= (forward-line n) 0) - (next-line 1) - t)) + (let ((pt (point))) + (and (= (forward-line n) 0) + ;; Deal with end of buffer + (or (not (eobp)) + (goto-char pt))))) (defun cua--rectangle-resized () ;; Refresh state after resizing rectangle (setq cua--buffer-and-point-before-command nil) - (cua--pad-rectangle) (cua--rectangle-insert-col 0) (cua--rectangle-set-corners) (cua--keep-active)) @@ -294,47 +307,35 @@ Knows about CUA rectangle highlighting in addition to standard undo." (defun cua-resize-rectangle-right (n) "Resize rectangle to the right." (interactive "p") - (let ((pad (cua--rectangle-padding)) (resized (> n 0))) + (let ((resized (> n 0))) (while (> n 0) (setq n (1- n)) (cond - ((and (cua--rectangle-right-side) (or pad (eolp))) - (cua--rectangle-right (1+ (cua--rectangle-right))) - (move-to-column (cua--rectangle-right) pad)) ((cua--rectangle-right-side) - (forward-char 1) - (cua--rectangle-right (current-column))) - ((or pad (eolp)) - (cua--rectangle-left (1+ (cua--rectangle-left))) - (move-to-column (cua--rectangle-right) pad)) + (cua--rectangle-right (1+ (cua--rectangle-right))) + (move-to-column (cua--rectangle-right))) (t - (forward-char 1) - (cua--rectangle-left (current-column))))) + (cua--rectangle-left (1+ (cua--rectangle-left))) + (move-to-column (cua--rectangle-right))))) (if resized (cua--rectangle-resized)))) (defun cua-resize-rectangle-left (n) "Resize rectangle to the left." (interactive "p") - (let ((pad (cua--rectangle-padding)) resized) + (let (resized) (while (> n 0) (setq n (1- n)) (if (or (= (cua--rectangle-right) 0) (and (not (cua--rectangle-right-side)) (= (cua--rectangle-left) 0))) (setq n 0) (cond - ((and (cua--rectangle-right-side) (or pad (eolp) (bolp))) - (cua--rectangle-right (1- (cua--rectangle-right))) - (move-to-column (cua--rectangle-right) pad)) ((cua--rectangle-right-side) - (backward-char 1) - (cua--rectangle-right (current-column))) - ((or pad (eolp) (bolp)) - (cua--rectangle-left (1- (cua--rectangle-left))) - (move-to-column (cua--rectangle-right) pad)) + (cua--rectangle-right (1- (cua--rectangle-right))) + (move-to-column (cua--rectangle-right))) (t - (backward-char 1) - (cua--rectangle-left (current-column)))) + (cua--rectangle-left (1- (cua--rectangle-left))) + (move-to-column (cua--rectangle-right)))) (setq resized t))) (if resized (cua--rectangle-resized)))) @@ -342,20 +343,20 @@ Knows about CUA rectangle highlighting in addition to standard undo." (defun cua-resize-rectangle-down (n) "Resize rectangle downwards." (interactive "p") - (let ((pad (cua--rectangle-padding)) resized) + (let (resized) (while (> n 0) (setq n (1- n)) (cond ((>= (cua--rectangle-corner) 2) (goto-char (cua--rectangle-bot)) - (when (cua--forward-line 1 pad) - (move-to-column (cua--rectangle-column) pad) + (when (cua--forward-line 1) + (move-to-column (cua--rectangle-column)) (cua--rectangle-bot t) (setq resized t))) (t (goto-char (cua--rectangle-top)) - (when (cua--forward-line 1 pad) - (move-to-column (cua--rectangle-column) pad) + (when (cua--forward-line 1) + (move-to-column (cua--rectangle-column)) (cua--rectangle-top t) (setq resized t))))) (if resized @@ -364,20 +365,20 @@ Knows about CUA rectangle highlighting in addition to standard undo." (defun cua-resize-rectangle-up (n) "Resize rectangle upwards." (interactive "p") - (let ((pad (cua--rectangle-padding)) resized) + (let (resized) (while (> n 0) (setq n (1- n)) (cond ((>= (cua--rectangle-corner) 2) (goto-char (cua--rectangle-bot)) - (when (cua--forward-line -1 pad) - (move-to-column (cua--rectangle-column) pad) + (when (cua--forward-line -1) + (move-to-column (cua--rectangle-column)) (cua--rectangle-bot t) (setq resized t))) (t (goto-char (cua--rectangle-top)) - (when (cua--forward-line -1 pad) - (move-to-column (cua--rectangle-column) pad) + (when (cua--forward-line -1) + (move-to-column (cua--rectangle-column)) (cua--rectangle-top t) (setq resized t))))) (if resized @@ -408,7 +409,7 @@ Knows about CUA rectangle highlighting in addition to standard undo." "Resize rectangle to bottom of buffer." (interactive) (goto-char (point-max)) - (move-to-column (cua--rectangle-column) (cua--rectangle-padding)) + (move-to-column (cua--rectangle-column)) (cua--rectangle-bot t) (cua--rectangle-resized)) @@ -416,31 +417,29 @@ Knows about CUA rectangle highlighting in addition to standard undo." "Resize rectangle to top of buffer." (interactive) (goto-char (point-min)) - (move-to-column (cua--rectangle-column) (cua--rectangle-padding)) + (move-to-column (cua--rectangle-column)) (cua--rectangle-top t) (cua--rectangle-resized)) (defun cua-resize-rectangle-page-up () "Resize rectangle upwards by one scroll page." (interactive) - (let ((pad (cua--rectangle-padding))) - (scroll-down) - (move-to-column (cua--rectangle-column) pad) - (if (>= (cua--rectangle-corner) 2) - (cua--rectangle-bot t) - (cua--rectangle-top t)) - (cua--rectangle-resized))) + (scroll-down) + (move-to-column (cua--rectangle-column)) + (if (>= (cua--rectangle-corner) 2) + (cua--rectangle-bot t) + (cua--rectangle-top t)) + (cua--rectangle-resized)) (defun cua-resize-rectangle-page-down () "Resize rectangle downwards by one scroll page." (interactive) - (let ((pad (cua--rectangle-padding))) - (scroll-up) - (move-to-column (cua--rectangle-column) pad) - (if (>= (cua--rectangle-corner) 2) - (cua--rectangle-bot t) - (cua--rectangle-top t)) - (cua--rectangle-resized))) + (scroll-up) + (move-to-column (cua--rectangle-column)) + (if (>= (cua--rectangle-corner) 2) + (cua--rectangle-bot t) + (cua--rectangle-top t)) + (cua--rectangle-resized)) ;;; Mouse support @@ -450,7 +449,8 @@ Knows about CUA rectangle highlighting in addition to standard undo." "Set rectangle corner at mouse click position." (interactive "e") (mouse-set-point event) - (if (cua--rectangle-padding) + ;; FIX ME -- need to calculate virtual column. + (if (cua--rectangle-virtual-edges) (move-to-column (car (posn-col-row (event-end event))) t)) (if (cua--rectangle-right-side) (cua--rectangle-right (current-column)) @@ -470,6 +470,7 @@ Knows about CUA rectangle highlighting in addition to standard undo." (cua--deactivate t)) (setq cua--last-rectangle nil) (mouse-set-point event) + ;; FIX ME -- need to calculate virtual column. (cua-set-rectangle-mark) (setq cua--buffer-and-point-before-command nil) (setq cua--mouse-last-pos nil)) @@ -489,13 +490,13 @@ If command is repeated at same position, delete the rectangle." (let ((cua-keep-region-after-copy t)) (cua-copy-rectangle arg) (setq cua--mouse-last-pos (cons (point) cua--last-killed-rectangle))))) + (defun cua--mouse-ignore (event) (interactive "e") (setq this-command last-command)) (defun cua--rectangle-move (dir) - (let ((pad (cua--rectangle-padding)) - (moved t) + (let ((moved t) (top (cua--rectangle-top)) (bot (cua--rectangle-bot)) (l (cua--rectangle-left)) @@ -503,17 +504,17 @@ If command is repeated at same position, delete the rectangle." (cond ((eq dir 'up) (goto-char top) - (when (cua--forward-line -1 pad) + (when (cua--forward-line -1) (cua--rectangle-top t) (goto-char bot) (forward-line -1) (cua--rectangle-bot t))) ((eq dir 'down) (goto-char bot) - (when (cua--forward-line 1 pad) + (when (cua--forward-line 1) (cua--rectangle-bot t) (goto-char top) - (cua--forward-line 1 pad) + (cua--forward-line 1) (cua--rectangle-top t))) ((eq dir 'left) (when (> l 0) @@ -526,19 +527,37 @@ If command is repeated at same position, delete the rectangle." (setq moved nil))) (when moved (setq cua--buffer-and-point-before-command nil) - (cua--pad-rectangle) (cua--rectangle-set-corners) (cua--keep-active)))) ;;; Operations on current rectangle -(defun cua--rectangle-operation (keep-clear visible undo pad &optional fct post-fct) +(defun cua--tabify-start (start end) + ;; Return position where auto-tabify should start (or nil if not required). + (save-excursion + (save-restriction + (widen) + (and (not buffer-read-only) + cua-auto-tabify-rectangles + (if (or (not (integerp cua-auto-tabify-rectangles)) + (= (point-min) (point-max)) + (progn + (goto-char (max (point-min) + (- start cua-auto-tabify-rectangles))) + (search-forward "\t" (min (point-max) + (+ end cua-auto-tabify-rectangles)) t))) + start))))) + +(defun cua--rectangle-operation (keep-clear visible undo pad tabify &optional fct post-fct) ;; Call FCT for each line of region with 4 parameters: ;; Region start, end, left-col, right-col ;; Point is at start when FCT is called + ;; Call fct with (s,e) = whole lines if VISIBLE non-nil. + ;; Only call fct for visible lines if VISIBLE==t. ;; Set undo boundary if UNDO is non-nil. - ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-padding) + ;; Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges) + ;; Perform auto-tabify after operation if TABIFY is non-nil. ;; Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear. (let* ((start (cua--rectangle-top)) (end (cua--rectangle-bot)) @@ -546,11 +565,12 @@ If command is repeated at same position, delete the rectangle." (r (1+ (cua--rectangle-right))) (m (make-marker)) (tabpad (and (integerp pad) (= pad 2))) - (sel (cua--rectangle-restriction))) + (sel (cua--rectangle-restriction)) + (tabify-start (and tabify (cua--tabify-start start end)))) (if undo (cua--rectangle-undo-boundary)) (if (integerp pad) - (setq pad (cua--rectangle-padding))) + (setq pad (cua--rectangle-virtual-edges))) (save-excursion (save-restriction (widen) @@ -558,11 +578,13 @@ If command is repeated at same position, delete the rectangle." (goto-char end) (and (bolp) (not (eolp)) (not (eobp)) (setq end (1+ end)))) - (when visible + (when (eq visible t) (setq start (max (window-start) start)) (setq end (min (window-end) end))) (goto-char end) (setq end (line-end-position)) + (if (and visible (bolp) (not (eobp))) + (setq end (1+ end))) (goto-char start) (setq start (line-beginning-position)) (narrow-to-region start end) @@ -575,7 +597,7 @@ If command is repeated at same position, delete the rectangle." (forward-char 1)) (set-marker m (point)) (move-to-column l pad) - (if (and fct (>= (current-column) l) (<= (current-column) r)) + (if (and fct (or visible (and (>= (current-column) l) (<= (current-column) r)))) (let ((v t) (p (point))) (when sel (if (car (cdr sel)) @@ -585,8 +607,7 @@ If command is repeated at same position, delete the rectangle." (if (car (cdr (cdr sel))) (setq v (null v)))) (if visible - (unless (eolp) - (funcall fct p m l r v)) + (funcall fct p m l r v) (if v (funcall fct p m l r))))) (set-marker m nil) @@ -594,7 +615,9 @@ If command is repeated at same position, delete the rectangle." (if (not visible) (cua--rectangle-bot t)) (if post-fct - (funcall post-fct l r)))) + (funcall post-fct l r)) + (when tabify-start + (tabify tabify-start (point))))) (cond ((eq keep-clear 'keep) (cua--keep-active)) @@ -607,48 +630,96 @@ If command is repeated at same position, delete the rectangle." (put 'cua--rectangle-operation 'lisp-indent-function 4) -(defun cua--pad-rectangle (&optional pad) - (if (or pad (cua--rectangle-padding)) - (cua--rectangle-operation nil nil t t))) - (defun cua--delete-rectangle () - (cua--rectangle-operation nil nil t 2 - '(lambda (s e l r) - (if (and (> e s) (<= e (point-max))) - (delete-region s e))))) + (let ((lines 0)) + (if (not (cua--rectangle-virtual-edges)) + (cua--rectangle-operation nil nil t 2 t + '(lambda (s e l r v) + (setq lines (1+ lines)) + (if (and (> e s) (<= e (point-max))) + (delete-region s e)))) + (cua--rectangle-operation nil 1 t nil t + '(lambda (s e l r v) + (setq lines (1+ lines)) + (when (and (> e s) (<= e (point-max))) + (delete-region s e))))) + lines)) (defun cua--extract-rectangle () (let (rect) - (cua--rectangle-operation nil nil nil 1 - '(lambda (s e l r) - (setq rect (cons (buffer-substring-no-properties s e) rect)))) - (nreverse rect))) - -(defun cua--insert-rectangle (rect &optional below) + (if (not (cua--rectangle-virtual-edges)) + (cua--rectangle-operation nil nil nil nil nil ; do not tabify + '(lambda (s e l r) + (setq rect (cons (buffer-substring-no-properties s e) rect)))) + (cua--rectangle-operation nil 1 nil nil nil ; do not tabify + '(lambda (s e l r v) + (let ((copy t) (bs 0) (as 0) row) + (if (= s e) (setq e (1+ e))) + (goto-char s) + (move-to-column l) + (if (= (point) (line-end-position)) + (setq bs (- r l) + copy nil) + (skip-chars-forward "\s\t" e) + (setq bs (- (min r (current-column)) l) + s (point)) + (move-to-column r) + (skip-chars-backward "\s\t" s) + (setq as (- r (max (current-column) l)) + e (point))) + (setq row (if (and copy (> e s)) + (buffer-substring-no-properties s e) + "")) + (when (> bs 0) + (setq row (concat (make-string bs ?\s) row))) + (when (> as 0) + (setq row (concat row (make-string as ?\s)))) + (setq rect (cons row rect)))))) + (nreverse rect))) + +(defun cua--insert-rectangle (rect &optional below paste-column line-count) ;; Insert rectangle as insert-rectangle, but don't set mark and exit with ;; point at either next to top right or below bottom left corner ;; Notice: In overwrite mode, the rectangle is inserted as separate text lines. - (if (and below (eq below 'auto)) + (if (eq below 'auto) (setq below (and (bolp) (or (eolp) (eobp) (= (1+ (point)) (point-max)))))) + (unless paste-column + (setq paste-column (current-column))) (let ((lines rect) - (insertcolumn (current-column)) (first t) + (tabify-start (cua--tabify-start (point) (point))) + last-column p) (while (or lines below) (or first (if overwrite-mode (insert ?\n) (forward-line 1) - (or (bolp) (insert ?\n)) - (move-to-column insertcolumn t))) + (or (bolp) (insert ?\n)))) + (unless overwrite-mode + (move-to-column paste-column t)) (if (not lines) (setq below nil) (insert-for-yank (car lines)) + (unless last-column + (setq last-column (current-column))) (setq lines (cdr lines)) (and first (not below) (setq p (point)))) - (setq first nil)) + (setq first nil) + (if (and line-count (= (setq line-count (1- line-count)) 0)) + (setq lines nil))) + (when (and line-count last-column (not overwrite-mode)) + (while (> line-count 0) + (forward-line 1) + (or (bolp) (insert ?\n)) + (move-to-column paste-column t) + (insert-char ?\s (- last-column paste-column -1)) + (setq line-count (1- line-count)))) + (when (and tabify-start + (not overwrite-mode)) + (tabify tabify-start (point))) (and p (not overwrite-mode) (goto-char p)))) @@ -662,7 +733,7 @@ If command is repeated at same position, delete the rectangle." (function (lambda (row) (concat row "\n"))) killed-rectangle ""))))) -(defun cua--activate-rectangle (&optional force) +(defun cua--activate-rectangle () ;; Turn on rectangular marking mode by disabling transient mark mode ;; and manually handling highlighting from a post command hook. ;; Be careful if we are already marking a rectangle. @@ -671,12 +742,8 @@ If command is repeated at same position, delete the rectangle." (eq (car cua--last-rectangle) (current-buffer)) (eq (car (cdr cua--last-rectangle)) (point))) (cdr (cdr cua--last-rectangle)) - (cua--rectangle-get-corners - (and (not buffer-read-only) - (or cua-auto-expand-rectangles - force - (eq major-mode 'picture-mode))))) - cua--status-string (if (cua--rectangle-padding) " Pad" "") + (cua--rectangle-get-corners)) + cua--status-string (if (cua--rectangle-virtual-edges) " [R]" "") cua--last-rectangle nil)) ;; (defvar cua-save-point nil) @@ -698,7 +765,7 @@ If command is repeated at same position, delete the rectangle." ;; Each overlay extends across all the columns of the rectangle. ;; We try to reuse overlays where possible because this is more efficient ;; and results in less flicker. - ;; If cua--rectangle-padding is nil and the buffer contains tabs or short lines, + ;; If cua--rectangle-virtual-edges is nil and the buffer contains tabs or short lines, ;; the higlighted region may not be perfectly rectangular. (let ((deactivate-mark deactivate-mark) (old cua--rectangle-overlays) @@ -707,12 +774,67 @@ If command is repeated at same position, delete the rectangle." (right (1+ (cua--rectangle-right)))) (when (/= left right) (sit-for 0) ; make window top/bottom reliable - (cua--rectangle-operation nil t nil nil + (cua--rectangle-operation nil t nil nil nil ; do not tabify '(lambda (s e l r v) (let ((rface (if v 'cua-rectangle-face 'cua-rectangle-noselect-face)) - overlay) - ;; Trim old leading overlays. + overlay bs ms as) (if (= s e) (setq e (1+ e))) + (when (cua--rectangle-virtual-edges) + (let ((lb (line-beginning-position)) + (le (line-end-position)) + cl cl0 pl cr cr0 pr) + (goto-char s) + (setq cl (move-to-column l) + pl (point)) + (setq cr (move-to-column r) + pr (point)) + (if (= lb pl) + (setq cl0 0) + (goto-char (1- pl)) + (setq cl0 (current-column))) + (if (= lb le) + (setq cr0 0) + (goto-char (1- pr)) + (setq cr0 (current-column))) + (unless (and (= cl l) (= cr r)) + (when (/= cl l) + (setq bs (propertize + (make-string + (- l cl0 (if (and (= le pl) (/= le lb)) 1 0)) + (if cua--virtual-edges-debug ?. ?\s)) + 'face 'default)) + (if (/= pl le) + (setq s (1- s)))) + (cond + ((= cr r) + (if (and (/= pr le) + (/= cr0 (1- cr)) + (or bs (/= cr0 (- cr tab-width))) + (/= (mod cr tab-width) 0)) + (setq e (1- e)))) + ((= cr cl) + (setq ms (propertize + (make-string + (- r l) + (if cua--virtual-edges-debug ?, ?\s)) + 'face rface)) + (if (cua--rectangle-right-side) + (put-text-property (1- (length ms)) (length ms) 'cursor t ms) + (put-text-property 0 1 'cursor t ms)) + (setq bs (concat bs ms)) + (setq rface nil)) + (t + (setq as (propertize + (make-string + (- r cr0 (if (= le pr) 1 0)) + (if cua--virtual-edges-debug ?~ ?\s)) + 'face rface)) + (if (cua--rectangle-right-side) + (put-text-property (1- (length as)) (length as) 'cursor t as) + (put-text-property 0 1 'cursor t as)) + (if (/= pr le) + (setq e (1- e)))))))) + ;; Trim old leading overlays. (while (and old (setq overlay (car old)) (< (overlay-start overlay) s) @@ -728,8 +850,11 @@ If command is repeated at same position, delete the rectangle." (move-overlay overlay s e) (setq old (cdr old))) (setq overlay (make-overlay s e))) - (overlay-put overlay 'face rface) - (setq new (cons overlay new)))))) + (overlay-put overlay 'before-string bs) + (overlay-put overlay 'after-string as) + (overlay-put overlay 'face rface) + (overlay-put overlay 'keymap cua--overlay-keymap) + (setq new (cons overlay new)))))) ;; Trim old trailing overlays. (mapcar (function delete-overlay) old) (setq cua--rectangle-overlays (nreverse new)))) @@ -737,9 +862,9 @@ If command is repeated at same position, delete the rectangle." (defun cua--indent-rectangle (&optional ch to-col clear) ;; Indent current rectangle. (let ((col (cua--rectangle-insert-col)) - (pad (cua--rectangle-padding)) + (pad (cua--rectangle-virtual-edges)) indent) - (cua--rectangle-operation (if clear 'clear 'corners) nil t pad + (cua--rectangle-operation (if clear 'clear 'corners) nil t pad nil '(lambda (s e l r) (move-to-column col pad) (if (and (eolp) @@ -875,23 +1000,22 @@ With prefix argument, the toggle restriction." (defun cua-rotate-rectangle () (interactive) (cua--rectangle-corner (if (= (cua--rectangle-left) (cua--rectangle-right)) 0 1)) - (cua--rectangle-set-corners)) + (cua--rectangle-set-corners) + (if (cua--rectangle-virtual-edges) + (setq cua--buffer-and-point-before-command nil))) -(defun cua-toggle-rectangle-padding () +(defun cua-toggle-rectangle-virtual-edges () (interactive) - (if buffer-read-only - (message "Cannot do padding in read-only buffer.") - (cua--rectangle-padding t (not (cua--rectangle-padding))) - (cua--pad-rectangle) - (cua--rectangle-set-corners)) - (setq cua--status-string (and (cua--rectangle-padding) " Pad")) + (cua--rectangle-virtual-edges t (not (cua--rectangle-virtual-edges))) + (cua--rectangle-set-corners) + (setq cua--status-string (and (cua--rectangle-virtual-edges) " [R]")) (cua--keep-active)) (defun cua-do-rectangle-padding () (interactive) (if buffer-read-only (message "Cannot do padding in read-only buffer.") - (cua--pad-rectangle t) + (cua--rectangle-operation nil nil t t t) (cua--rectangle-set-corners)) (cua--keep-active)) @@ -900,7 +1024,7 @@ With prefix argument, the toggle restriction." The text previously in the region is not overwritten by the blanks, but instead winds up to the right of the rectangle." (interactive) - (cua--rectangle-operation 'corners nil t 1 + (cua--rectangle-operation 'corners nil t 1 nil '(lambda (s e l r) (skip-chars-forward " \t") (let ((ws (- (current-column) l)) @@ -915,7 +1039,7 @@ On each line in the rectangle, all continuous whitespace starting at that column is deleted. With prefix arg, also delete whitespace to the left of that column." (interactive "P") - (cua--rectangle-operation 'clear nil t 1 + (cua--rectangle-operation 'clear nil t 1 nil '(lambda (s e l r) (when arg (skip-syntax-backward " " (line-beginning-position)) @@ -927,7 +1051,7 @@ With prefix arg, also delete whitespace to the left of that column." "Blank out CUA rectangle. The text previously in the rectangle is overwritten by the blanks." (interactive) - (cua--rectangle-operation 'keep nil nil 1 + (cua--rectangle-operation 'keep nil nil 1 nil '(lambda (s e l r) (goto-char e) (skip-syntax-forward " " (line-end-position)) @@ -942,7 +1066,7 @@ The text previously in the rectangle is overwritten by the blanks." "Align rectangle lines to left column." (interactive) (let (x) - (cua--rectangle-operation 'clear nil t t + (cua--rectangle-operation 'clear nil t t nil '(lambda (s e l r) (let ((b (line-beginning-position))) (skip-syntax-backward "^ " b) @@ -984,7 +1108,7 @@ The text previously in the rectangle is overwritten by the blanks." "Replace CUA rectangle contents with STRING on each line. The length of STRING need not be the same as the rectangle width." (interactive "sString rectangle: ") - (cua--rectangle-operation 'keep nil t t + (cua--rectangle-operation 'keep nil t t nil '(lambda (s e l r) (delete-region s e) (skip-chars-forward " \t") @@ -999,7 +1123,7 @@ The length of STRING need not be the same as the rectangle width." (defun cua-fill-char-rectangle (ch) "Replace CUA rectangle contents with CHARACTER." (interactive "cFill rectangle with character: ") - (cua--rectangle-operation 'clear nil t 1 + (cua--rectangle-operation 'clear nil t 1 nil '(lambda (s e l r) (delete-region s e) (move-to-column l t) @@ -1010,7 +1134,7 @@ The length of STRING need not be the same as the rectangle width." (interactive "sReplace regexp: \nsNew text: ") (if buffer-read-only (message "Cannot replace in read-only buffer") - (cua--rectangle-operation 'keep nil t 1 + (cua--rectangle-operation 'keep nil t 1 nil '(lambda (s e l r) (if (re-search-forward regexp e t) (replace-match newtext nil nil)))))) @@ -1018,7 +1142,7 @@ The length of STRING need not be the same as the rectangle width." (defun cua-incr-rectangle (increment) "Increment each line of CUA rectangle by prefix amount." (interactive "p") - (cua--rectangle-operation 'keep nil t 1 + (cua--rectangle-operation 'keep nil t 1 nil '(lambda (s e l r) (cond ((re-search-forward "0x\\([0-9a-fA-F]+\\)" e t) @@ -1051,36 +1175,36 @@ The numbers are formatted according to the FORMAT string." (if (= (length fmt) 0) (setq fmt cua--rectangle-seq-format) (setq cua--rectangle-seq-format fmt)) - (cua--rectangle-operation 'clear nil t 1 + (cua--rectangle-operation 'clear nil t 1 nil '(lambda (s e l r) (delete-region s e) (insert (format fmt first)) (setq first (+ first incr))))) -(defmacro cua--convert-rectangle-as (command) - `(cua--rectangle-operation 'clear nil nil nil +(defmacro cua--convert-rectangle-as (command tabify) + `(cua--rectangle-operation 'clear nil nil nil ,tabify '(lambda (s e l r) (,command s e)))) (defun cua-upcase-rectangle () "Convert the rectangle to upper case." (interactive) - (cua--convert-rectangle-as upcase-region)) + (cua--convert-rectangle-as upcase-region nil)) (defun cua-downcase-rectangle () "Convert the rectangle to lower case." (interactive) - (cua--convert-rectangle-as downcase-region)) + (cua--convert-rectangle-as downcase-region nil)) (defun cua-upcase-initials-rectangle () "Convert the rectangle initials to upper case." (interactive) - (cua--convert-rectangle-as upcase-initials-region)) + (cua--convert-rectangle-as upcase-initials-region nil)) (defun cua-capitalize-rectangle () "Convert the rectangle to proper case." (interactive) - (cua--convert-rectangle-as capitalize-region)) + (cua--convert-rectangle-as capitalize-region nil)) ;;; Replace/rearrange text in current rectangle @@ -1116,7 +1240,7 @@ The numbers are formatted according to the FORMAT string." (setq z (reverse z)) (if cua--debug (print z auxbuf)) - (cua--rectangle-operation nil nil t pad + (cua--rectangle-operation nil nil t pad nil '(lambda (s e l r) (let (cc) (goto-char e) @@ -1232,9 +1356,9 @@ With prefix arg, indent to that column." "Delete char to left or right of rectangle." (interactive) (let ((col (cua--rectangle-insert-col)) - (pad (cua--rectangle-padding)) + (pad (cua--rectangle-virtual-edges)) indent) - (cua--rectangle-operation 'corners nil t pad + (cua--rectangle-operation 'corners nil t pad nil '(lambda (s e l r) (move-to-column (if (cua--rectangle-right-side t) @@ -1282,10 +1406,7 @@ With prefix arg, indent to that column." (cua--rectangle-left (current-column))) (if (>= (cua--rectangle-corner) 2) (cua--rectangle-bot t) - (cua--rectangle-top t)) - (if (cua--rectangle-padding) - (setq unread-command-events - (cons (if cua-use-hyper-key ?\H-P ?\M-P) unread-command-events))))) + (cua--rectangle-top t)))) (if cua--rectangle (if (and mark-active (not deactivate-mark)) @@ -1379,7 +1500,7 @@ With prefix arg, indent to that column." (cua--rect-M/H-key ?m 'cua-copy-rectangle-as-text) (cua--rect-M/H-key ?n 'cua-sequence-rectangle) (cua--rect-M/H-key ?o 'cua-open-rectangle) - (cua--rect-M/H-key ?p 'cua-toggle-rectangle-padding) + (cua--rect-M/H-key ?p 'cua-toggle-rectangle-virtual-edges) (cua--rect-M/H-key ?P 'cua-do-rectangle-padding) (cua--rect-M/H-key ?q 'cua-refill-rectangle) (cua--rect-M/H-key ?r 'cua-replace-in-rectangle) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 36dac14f6a9..052e92391af 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -358,8 +358,9 @@ Each element in a user-level keywords list should have one of these forms: (eval . FORM) where MATCHER can be either the regexp to search for, or the function name to -call to make the search (called with one argument, the limit of the search) and -return non-nil if it succeeds (and set `match-data' appropriately). +call to make the search (called with one argument, the limit of the search; +it should return non-nil, move point, and set `match-data' appropriately iff +it succeeds; like `re-search-forward' would). MATCHER regexps can be generated via the function `regexp-opt'. FORM is an expression, whose value should be a keyword element, evaluated when @@ -1515,7 +1516,9 @@ Sets various variables using `font-lock-defaults' (or, if nil, using (make-local-variable 'font-lock-fontified) (make-local-variable 'font-lock-multiline) (let* ((defaults (or font-lock-defaults - (cdr (assq major-mode font-lock-defaults-alist)))) + (cdr (assq major-mode + (with-no-warnings + font-lock-defaults-alist))))) (keywords (font-lock-choose-keywords (nth 0 defaults) (font-lock-value-in-major-mode font-lock-maximum-decoration))) diff --git a/lisp/frame.el b/lisp/frame.el index 521938cfc18..8d979cdaff4 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -520,7 +520,7 @@ React to settings of `default-frame-alist', `initial-frame-alist' there." ;;;; Creation of additional frames, and other frame miscellanea (defun modify-all-frames-parameters (alist) - "Modify all current and future frames parameters according to ALIST. + "Modify all current and future frames' parameters according to ALIST. This changes `default-frame-alist' and possibly `initial-frame-alist'. See help of `modify-frame-parameters' for more information." (let (element) ;; temp @@ -612,7 +612,13 @@ You cannot specify either `width' or `height', you must use neither or both. Before the frame is created (via `frame-creation-function'), functions on the hook `before-make-frame-hook' are run. After the frame is created, functions -on `after-make-frame-functions' are run with one arg, the newly created frame." +on `after-make-frame-functions' are run with one arg, the newly created frame. + +This function itself does not make the new frame the selected frame. +The previously selected frame remains selected. However, the +window system may select the new frame for its own reasons, for +instance if the frame appears under the mouse pointer and your +setup is for focus to follow the pointer." (interactive) (run-hooks 'before-make-frame-hook) (let ((frame (funcall frame-creation-function parameters))) @@ -789,6 +795,8 @@ where "Restore the frames to the state described by CONFIGURATION. Each frame listed in CONFIGURATION has its position, size, window configuration, and other parameters set as specified in CONFIGURATION. +However, this function does not restore deleted frames. + Ordinarily, this function deletes all existing frames not listed in CONFIGURATION. But if optional second argument NODELETE is given and non-nil, the unwanted frames are iconified instead." @@ -979,7 +987,8 @@ frame's display)." ((eq frame-type 'pc) (msdos-mouse-p)) ((eq system-type 'windows-nt) - (> w32-num-mouse-buttons 0)) + (with-no-warnings + (> w32-num-mouse-buttons 0))) ((memq frame-type '(x mac)) t) ;; We assume X and Mac *always* have a pointing device (t @@ -1032,7 +1041,8 @@ frame's display)." ((eq frame-type 'pc) ;; MS-DOG frames support selections when Emacs runs inside ;; the Windows' DOS Box. - (not (null dos-windows-version))) + (with-no-warnings + (not (null dos-windows-version)))) ((memq frame-type '(x w32 mac)) t) ;; FIXME? (t diff --git a/lisp/help-fns.el b/lisp/help-fns.el index e534c6998a7..d193ad344f5 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -461,18 +461,21 @@ face (according to `face-differs-from-default-p')." (defun variable-at-point () "Return the bound variable symbol found around point. Return 0 if there is no such symbol." - (condition-case () - (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (following-char)) ?w) - (eq (char-syntax (following-char)) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (or (and (symbolp obj) (boundp obj) obj) - 0)))) - (error 0))) + (or (condition-case () + (with-syntax-table emacs-lisp-mode-syntax-table + (save-excursion + (or (not (zerop (skip-syntax-backward "_w"))) + (eq (char-syntax (following-char)) ?w) + (eq (char-syntax (following-char)) ?_) + (forward-sexp -1)) + (skip-chars-forward "'") + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (boundp obj) obj)))) + (error nil)) + (let* ((str (find-tag-default)) + (obj (if str (read str)))) + (and (symbolp obj) (boundp obj) obj)) + 0)) ;;;###autoload (defun describe-variable (variable &optional buffer) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 11656ec368c..a2dcdf91ed8 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -581,7 +581,7 @@ help buffer." (interactive) (if help-xref-stack (help-xref-go-back (current-buffer)) - (error "No previous help buffer."))) + (error "No previous help buffer"))) (defun help-do-xref (pos function args) "Call the help cross-reference function FUNCTION with args ARGS. diff --git a/lisp/help.el b/lisp/help.el index fc43d8db03d..bf0df4358a7 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -237,32 +237,35 @@ C-w Display information on absence of warranty for GNU Emacs." (defun function-called-at-point () "Return a function around point or else called by the list containing point. If that doesn't give a function, return nil." - (with-syntax-table emacs-lisp-mode-syntax-table - (or (condition-case () - (save-excursion - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (following-char)) ?w) - (eq (char-syntax (following-char)) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj))) - (error nil)) - (condition-case () - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) - (- (point) 1000)) (point-max)) - ;; Move up to surrounding paren, then after the open. - (backward-up-list 1) - (forward-char 1) - ;; If there is space here, this is probably something - ;; other than a real Lisp function call, so ignore it. - (if (looking-at "[ \t]") - (error "Probably not a Lisp function call")) - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj)))) - (error nil))))) + (or (with-syntax-table emacs-lisp-mode-syntax-table + (or (condition-case () + (save-excursion + (or (not (zerop (skip-syntax-backward "_w"))) + (eq (char-syntax (following-char)) ?w) + (eq (char-syntax (following-char)) ?_) + (forward-sexp -1)) + (skip-chars-forward "'") + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj))) + (error nil)) + (condition-case () + (save-excursion + (save-restriction + (narrow-to-region (max (point-min) + (- (point) 1000)) (point-max)) + ;; Move up to surrounding paren, then after the open. + (backward-up-list 1) + (forward-char 1) + ;; If there is space here, this is probably something + ;; other than a real Lisp function call, so ignore it. + (if (looking-at "[ \t]") + (error "Probably not a Lisp function call")) + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj)))) + (error nil)))) + (let* ((str (find-tag-default)) + (obj (if str (read str)))) + (and (symbolp obj) (fboundp obj) obj)))) ;;; `User' help functions @@ -428,7 +431,8 @@ We put that list in a buffer, and display the buffer. The optional argument PREFIX, if non-nil, should be a key sequence; then we display only bindings that start with that prefix. The optional argument BUFFER specifies which buffer's bindings -to display (default, the current buffer)." +to display (default, the current buffer). BUFFER can be a buffer +or a buffer name." (interactive) (or buffer (setq buffer (current-buffer))) (help-setup-xref (list #'describe-bindings prefix buffer) (interactive-p)) diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 140f2995292..f013f8e3c72 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -1644,16 +1644,17 @@ If point is on a group name, this function operates on that group." (dolist (string column-strings) (setq total ;; like, ewww ... - (+ (float (string-to-int string)) + (+ (float (string-to-number string)) total))) (format "%.0f" total)))) (format "%s" (buffer-size))) -(define-ibuffer-column mode (:inline t - :props - ('mouse-face 'highlight - 'keymap ibuffer-mode-name-map - 'help-echo "mouse-2: filter by this mode")) +(define-ibuffer-column mode + (:inline t + :props + ('mouse-face 'highlight + 'keymap ibuffer-mode-name-map + 'help-echo "mouse-2: filter by this mode")) (format "%s" mode-name)) (define-ibuffer-column process @@ -2198,7 +2199,7 @@ Try to restore the previous window configuration iff `ibuffer-restore-window-config-on-quit' is non-nil." (interactive) (if ibuffer-restore-window-config-on-quit - (progn + (progn (bury-buffer) (unless (= (count-windows) 1) (set-window-configuration ibuffer-prev-window-config))) diff --git a/lisp/ido.el b/lisp/ido.el index 4cbc88cf037..ae376741f1b 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -291,7 +291,7 @@ ;; then all files matching "Summary" are moved to the end of the ;; list. (I find this handy for keeping the INBOX Summary and so on ;; out of the way.) It also moves files matching "output\*$" to the -;; end of the list (these are created by AUC TeX when compiling.) +;; end of the list (these are created by AUCTeX when compiling.) ;; Other functions could be made available which alter the list of ;; matching files (either deleting or rearranging elements.) diff --git a/lisp/ielm.el b/lisp/ielm.el index 944e2453cb9..96969bfc878 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -198,7 +198,7 @@ This variable is buffer-local.") ;;; Completion stuff (defun ielm-tab nil - "Possibly indent the current line as lisp code." + "Possibly indent the current line as Lisp code." (interactive) (if (or (eq (preceding-char) ?\n) (eq (char-syntax (preceding-char)) ? )) @@ -207,7 +207,7 @@ This variable is buffer-local.") t))) (defun ielm-complete-symbol nil - "Complete the lisp symbol before point." + "Complete the Lisp symbol before point." ;; A wrapper for lisp-complete symbol that returns non-nil if ;; completion has occurred (let* ((btick (buffer-modified-tick)) @@ -528,7 +528,7 @@ Customized bindings may be defined in `ielm-map', which currently contains: (condition-case nil (start-process "ielm" (current-buffer) "hexl") (file-error (start-process "ielm" (current-buffer) "cat"))) - (process-kill-without-query (ielm-process)) + (set-process-query-on-exit-flag (ielm-process) nil) (goto-char (point-max)) ;; Lisp output can include raw characters that confuse comint's diff --git a/lisp/imenu.el b/lisp/imenu.el index e0b57440fd8..1c82fcacf34 100644 --- a/lisp/imenu.el +++ b/lisp/imenu.el @@ -1,6 +1,7 @@ ;;; imenu.el --- framework for mode-specific buffer indexes -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 2003, 2004 +;; Free Software Foundation, Inc. ;; Author: Ake Stenhoff <etxaksf@aom.ericsson.se> ;; Lars Lindberg <lli@sypro.cap.se> @@ -210,8 +211,6 @@ menu. See the info section on Regexps for more information. INDEX points to the substring in REGEXP that contains the name (of the function, variable or type) that is to appear in the menu. -The variable is buffer-local. - The variable `imenu-case-fold-search' determines whether or not the regexp matches are case sensitive, and `imenu-syntax-alist' can be used to alter the syntax table for the search. @@ -239,9 +238,7 @@ 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'. - -The variable is buffer-local.") +This function is called within a `save-excursion'.") ;;;###autoload (make-variable-buffer-local 'imenu-create-index-function) @@ -255,9 +252,7 @@ to a function that will find the next index, looking backwards in the file. The function should leave point at the place to be connected to the -index and it should return nil when it doesn't find another index. - -This variable is local in all buffers.") +index and it should return nil when it doesn't find another index.") ;;;###autoload (make-variable-buffer-local 'imenu-prev-index-position-function) @@ -267,9 +262,7 @@ This variable is local in all buffers.") This function is called after `imenu-prev-index-position-function' finds a position for an index item, with point at that position. -It should return the name for that index item. - -This variable is local in all buffers.") +It should return the name for that index item.") ;;;###autoload (make-variable-buffer-local 'imenu-extract-index-name-function) @@ -283,9 +276,7 @@ non-nil if they match. If nil, comparison is done with `string='. Set this to some other function for more advanced comparisons, such as \"begins with\" or \"name matches and number of -arguments match\". - -This variable is local in all buffers.") +arguments match\".") ;;;###autoload (make-variable-buffer-local 'imenu-name-lookup-function) @@ -453,9 +444,7 @@ The function in this variable is called when selecting a normal index-item.") "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). - -This variable is local in all buffers, once set.") +A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).") (make-variable-buffer-local 'imenu--index-alist) @@ -984,8 +973,7 @@ A trivial interface to `imenu-add-to-menubar' suitable for use in a hook." (defvar imenu-buffer-menubar nil) (defvar imenu-menubar-modified-tick 0 - "The value of (buffer-modified-tick) as of last call to `imenu-update-menubar'. -This value becomes local in every buffer when it is set.") + "The value of (buffer-modified-tick) as of last call to `imenu-update-menubar'.") (make-variable-buffer-local 'imenu-menubar-modified-tick) (defun imenu-update-menubar () diff --git a/lisp/indent.el b/lisp/indent.el index e56db11b6f1..2d223b05ad6 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -442,8 +442,8 @@ This should be a list of integers, ordered from smallest to largest." "Keymap used in `edit-tab-stops'.") (defvar edit-tab-stops-buffer nil - "Buffer whose tab stops are being edited--in case -the variable `tab-stop-list' is local in that buffer.") + "Buffer whose tab stops are being edited. +This matters if the variable `tab-stop-list' is local in that buffer.") (defun edit-tab-stops () "Edit the tab stops used by `tab-to-tab-stop'. diff --git a/lisp/info.el b/lisp/info.el index 43e1dafcc6f..802fcf1642e 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -188,7 +188,7 @@ file, so be prepared for a few surprises if you enable this feature." :type 'boolean :group 'info) -(defcustom Info-search-whitespace-regexp "\\\\(?:\\\\s-+\\\\)" +(defcustom Info-search-whitespace-regexp "\\(?:\\s-+\\)" "*If non-nil, regular expression to match a sequence of whitespace chars. This applies to Info search for regular expressions. You might want to use something like \"[ \\t\\r\\n]+\" instead. @@ -1442,8 +1442,9 @@ If FORK is a string, it is the name to use for the new buffer." (defvar Info-search-case-fold nil "The value of `case-fold-search' from previous `Info-search' command.") -(defun Info-search (regexp) - "Search for REGEXP, starting from point, and select node it's found in." +(defun Info-search (regexp &optional bound noerror count direction) + "Search for REGEXP, starting from point, and select node it's found in. +If DIRECTION is `backward', search in the reverse direction." (interactive (list (read-string (if Info-search-history (format "Regexp search%s (default `%s'): " @@ -1458,31 +1459,42 @@ If FORK is a string, it is the name to use for the new buffer." (setq regexp (car Info-search-history))) (when regexp (let (found beg-found give-up + (backward (eq direction 'backward)) (onode Info-current-node) (ofile Info-current-file) (opoint (point)) + (opoint-min (point-min)) + (opoint-max (point-max)) (ostart (window-start)) (osubfile Info-current-subfile)) (when Info-search-whitespace-regexp - (setq regexp (replace-regexp-in-string - "[ \t\n]+" Info-search-whitespace-regexp regexp))) + (setq regexp + (mapconcat 'identity (split-string regexp "[ \t\n]+") + Info-search-whitespace-regexp))) (setq Info-search-case-fold case-fold-search) (save-excursion (save-restriction (widen) (while (and (not give-up) (or (null found) - (isearch-range-invisible beg-found found))) - (if (re-search-forward regexp nil t) - (setq found (point) beg-found (match-beginning 0)) + (if backward + (isearch-range-invisible found beg-found) + (isearch-range-invisible beg-found found)))) + (if (if backward + (re-search-backward regexp bound t) + (re-search-forward regexp bound t)) + (setq found (point) beg-found (if backward (match-end 0) + (match-beginning 0))) (setq give-up t))))) ;; If no subfiles, give error now. (if give-up (if (null Info-current-subfile) - (re-search-forward regexp) + (if backward + (re-search-backward regexp) + (re-search-forward regexp)) (setq found nil))) - (unless found + (unless (or found bound) (unwind-protect ;; Try other subfiles. (let ((list ())) @@ -1498,29 +1510,39 @@ If FORK is a string, it is the name to use for the new buffer." ;; Find the subfile we just searched. (search-forward (concat "\n" osubfile ": ")) ;; Skip that one. - (forward-line 1) + (forward-line (if backward 0 1)) ;; Make a list of all following subfiles. ;; Each elt has the form (VIRT-POSITION . SUBFILENAME). - (while (not (eobp)) - (re-search-forward "\\(^.*\\): [0-9]+$") + (while (not (if backward (bobp) (eobp))) + (if backward + (re-search-backward "\\(^.*\\): [0-9]+$") + (re-search-forward "\\(^.*\\): [0-9]+$")) (goto-char (+ (match-end 1) 2)) (setq list (cons (cons (+ (point-min) (read (current-buffer))) (match-string-no-properties 1)) list)) - (goto-char (1+ (match-end 0)))) + (goto-char (if backward + (1- (match-beginning 0)) + (1+ (match-end 0))))) ;; Put in forward order (setq list (nreverse list)))) (while list (message "Searching subfile %s..." (cdr (car list))) (Info-read-subfile (car (car list))) + (if backward (goto-char (point-max))) (setq list (cdr list)) (setq give-up nil found nil) (while (and (not give-up) (or (null found) - (isearch-range-invisible beg-found found))) - (if (re-search-forward regexp nil t) - (setq found (point) beg-found (match-beginning 0)) + (if backward + (isearch-range-invisible found beg-found) + (isearch-range-invisible beg-found found)))) + (if (if backward + (re-search-backward regexp nil t) + (re-search-forward regexp nil t)) + (setq found (point) beg-found (if backward (match-end 0) + (match-beginning 0))) (setq give-up t))) (if give-up (setq found nil)) @@ -1534,12 +1556,20 @@ If FORK is a string, it is the name to use for the new buffer." (goto-char opoint) (Info-select-node) (set-window-start (selected-window) ostart))))) - (widen) - (goto-char found) - (Info-select-node) + + (if (and (string= osubfile Info-current-subfile) + (> found opoint-min) + (< found opoint-max)) + ;; Search landed in the same node + (goto-char found) + (widen) + (goto-char found) + (save-match-data (Info-select-node))) + ;; Use string-equal, not equal, to ignore text props. (or (and (string-equal onode Info-current-node) (equal ofile Info-current-file)) + (and isearch-mode isearch-wrapped (eq opoint opoint-min)) (setq Info-history (cons (list ofile onode opoint) Info-history)))))) @@ -1556,6 +1586,48 @@ If FORK is a string, it is the name to use for the new buffer." (if Info-search-history (Info-search (car Info-search-history)) (call-interactively 'Info-search)))) + +(defun Info-search-backward (regexp &optional bound noerror count) + "Search for REGEXP in the reverse direction." + (interactive (list (read-string + (if Info-search-history + (format "Regexp search%s backward (default `%s'): " + (if case-fold-search "" " case-sensitively") + (car Info-search-history)) + (format "Regexp search%s backward: " + (if case-fold-search "" " case-sensitively"))) + nil 'Info-search-history))) + (Info-search regexp bound noerror count 'backward)) + +(defun Info-isearch-search () + (cond + (isearch-word + (if isearch-forward 'word-search-forward 'word-search-backward)) + (isearch-regexp + (lambda (regexp bound noerror) + (condition-case nil + (progn + (Info-search regexp bound noerror nil + (unless isearch-forward 'backward)) + (point)) + (error nil)))) + (t + (if isearch-forward 'search-forward 'search-backward)))) + +(defun Info-isearch-wrap () + (if isearch-regexp + (if isearch-forward (Info-top-node) (Info-final-node)) + (goto-char (if isearch-forward (point-min) (point-max))))) + +(defun Info-isearch-push-state () + `(lambda (cmd) + (Info-isearch-pop-state cmd ,Info-current-file ,Info-current-node))) + +(defun Info-isearch-pop-state (cmd file node) + (or (and (string= Info-current-file file) + (string= Info-current-node node)) + (progn (Info-find-node file node) (sit-for 0)))) + (defun Info-extract-pointer (name &optional errorname) "Extract the value of the node-pointer named NAME. @@ -3064,6 +3136,14 @@ Advanced commands: (setq desktop-save-buffer 'Info-desktop-buffer-misc-data) (add-hook 'clone-buffer-hook 'Info-clone-buffer-hook nil t) (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) + (set (make-local-variable 'isearch-search-fun-function) + 'Info-isearch-search) + (set (make-local-variable 'isearch-wrap-function) + 'Info-isearch-wrap) + (set (make-local-variable 'isearch-push-state-function) + 'Info-isearch-push-state) + (set (make-local-variable 'search-whitespace-regexp) + Info-search-whitespace-regexp) (Info-set-mode-line) (run-hooks 'Info-mode-hook)) @@ -3445,23 +3525,24 @@ Preserve text properties." other-tag) (when not-fontified-p (when Info-hide-note-references - ;; *Note is often used where *note should have been - (goto-char start) - (skip-syntax-backward " ") - (setq other-tag - (cond ((memq (char-before) '(nil ?\. ?! ??)) - "See ") - ((memq (char-before) '(?\, ?\; ?\: ?-)) - "see ") - ((memq (char-before) '(?\( ?\[ ?\{)) - ;; Check whether the paren is preceded by - ;; an end of sentence - (skip-syntax-backward " (") - (if (memq (char-before) '(nil ?\. ?! ??)) - "See " - "see ")) - ((save-match-data (looking-at "\n\n")) - "See "))) + (when (not (eq Info-hide-note-references 'hide)) + ;; *Note is often used where *note should have been + (goto-char start) + (skip-syntax-backward " ") + (setq other-tag + (cond ((memq (char-before) '(nil ?\. ?! ??)) + "See ") + ((memq (char-before) '(?\, ?\; ?\: ?-)) + "see ") + ((memq (char-before) '(?\( ?\[ ?\{)) + ;; Check whether the paren is preceded by + ;; an end of sentence + (skip-syntax-backward " (") + (if (memq (char-before) '(nil ?\. ?! ??)) + "See " + "see ")) + ((save-match-data (looking-at "\n\n")) + "See ")))) (goto-char next) (add-text-properties (match-beginning 1) @@ -3471,7 +3552,7 @@ Preserve text properties." (if (string-match "\n" (match-string 1)) (+ start1 (match-beginning 0))))) (match-end 1)) - (if (and other-tag (not (eq Info-hide-note-references 'hide))) + (if other-tag `(display ,other-tag front-sticky nil rear-nonsticky t) '(invisible t front-sticky nil rear-nonsticky t)))) (add-text-properties diff --git a/lisp/international/encoded-kb.el b/lisp/international/encoded-kb.el index 6eae1011c40..cba2f0e45b9 100644 --- a/lisp/international/encoded-kb.el +++ b/lisp/international/encoded-kb.el @@ -24,6 +24,10 @@ ;;; Code: +;; Usually this map is empty (even if Encoded-kbd mode is on), but if +;; the keyboard coding system is iso-2022-based, it defines dummy key +;; bindings for ESC $ ..., etc. so that those bindings in +;; key-translation-map take effect. (defconst encoded-kbd-mode-map (make-sparse-keymap) "Keymap for Encoded-kbd minor mode.") @@ -69,25 +73,6 @@ (fset 'encoded-kbd-iso2022-designation-prefix encoded-kbd-iso2022-designation-map) -(defvar encoded-kbd-iso2022-non-ascii-map - (let ((map (make-keymap)) - (i 32)) - (while (< i 128) - (define-key map (char-to-string i) 'encoded-kbd-self-insert-iso2022-7bit) - (setq i (1+ i))) - (define-key map "\e" 'encoded-kbd-iso2022-esc-prefix) - (setq i 160) - (while (< i 256) - (define-key map (vector i) 'encoded-kbd-handle-8bit) - (setq i (1+ i))) - map) - "Keymap for handling non-ASCII character set in Encoded-kbd mode.") - -;; One of the symbols `sjis', `iso2022-7', `iso2022-8', or `big5' to -;; denote what kind of coding-system we are now handling in -;; Encoded-kbd mode. -(defvar encoded-kbd-coding nil) - ;; Keep information of designation state of ISO2022 encoding. When ;; Encoded-kbd mode is on, this is set to a vector of length 4, the ;; elements are character sets currently designated to graphic @@ -104,11 +89,14 @@ (defvar encoded-kbd-iso2022-invocations nil) (put 'encoded-kbd-iso2022-invocations 'permanent-local t) -(defun encoded-kbd-iso2022-designation () +(defsubst encoded-kbd-last-key () + (let ((keys (this-single-command-keys))) + (aref keys (1- (length keys))))) + +(defun encoded-kbd-iso2022-designation (ignore) "Do ISO2022 designation according to the current key in Encoded-kbd mode. The following key sequence may cause multilingual text insertion." - (interactive) - (let ((key-seq (this-command-keys)) + (let ((key-seq (this-single-command-keys)) (prev-g0-charset (aref encoded-kbd-iso2022-designations (aref encoded-kbd-iso2022-invocations 0))) intermediate-char final-char @@ -132,143 +120,122 @@ The following key sequence may cause multilingual text insertion." chars (if (< intermediate-char ?,) 94 96) final-char (aref key-seq 2) reg (mod intermediate-char 4)))) - (if (setq charset (iso-charset dimension chars final-char)) - (aset encoded-kbd-iso2022-designations reg charset) - (error "Character set of DIMENSION %s, CHARS %s, FINAL-CHAR `%c' is not supported" - dimension chars final-char)) - - (if (memq (aref encoded-kbd-iso2022-designations - (aref encoded-kbd-iso2022-invocations 0)) - '(ascii latin-jisx0201)) - ;; Graphic plane 0 (0x20..0x7f) is for ASCII. We don't have - ;; to handle characters in this range specially. - (if (not (memq prev-g0-charset '(ascii latin-jisx0201))) - ;; We must exit recursive edit now. - (throw 'exit nil)) - ;; Graphic plane 0 is for non-ASCII. - (if (memq prev-g0-charset '(ascii latin-jisx0201)) - ;; We must handle keys specially. - (let ((overriding-local-map encoded-kbd-iso2022-non-ascii-map)) - (recursive-edit)))))) - -(defun encoded-kbd-handle-8bit () - "Handle an 8-bit character entered in Encoded-kbd mode." - (interactive) - (cond ((eq encoded-kbd-coding 'iso2022-7) - (error "Can't handle the character code %d" last-command-char)) - - ((eq encoded-kbd-coding 'iso2022-8) - (cond ((= last-command-char ?\216) - (aset encoded-kbd-iso2022-invocations 2 2)) - - ((= last-command-char ?\217) - (aset encoded-kbd-iso2022-invocations 2 3)) - - ((>= last-command-char ?\240) - (encoded-kbd-self-insert-iso2022-8bit)) - - (t - (error "Can't handle the character code %d" - last-command-char)))) - - ((eq encoded-kbd-coding 'sjis) - (encoded-kbd-self-insert-sjis)) - - (t - (encoded-kbd-self-insert-big5)))) - -(defun encoded-kbd-self-insert-iso2022-7bit () - (interactive) - (let* ((charset (aref encoded-kbd-iso2022-designations - (or (aref encoded-kbd-iso2022-invocations 2) - (aref encoded-kbd-iso2022-invocations 0)))) - (char (if (= (charset-dimension charset) 1) - (make-char charset last-command-char) - (make-char charset last-command-char (read-char-exclusive))))) + (aset encoded-kbd-iso2022-designations reg + (iso-charset dimension chars final-char))) + "") + +(defun encoded-kbd-iso2022-single-shift (ignore) + (let ((char (encoded-kbd-last-key))) + (aset encoded-kbd-iso2022-invocations 2 + (aref encoded-kbd-iso2022-designations + (if (= char ?\216) 2 3)))) + "") + +(defun encoded-kbd-self-insert-iso2022-7bit (ignore) + (let ((char (encoded-kbd-last-key)) + (charset (aref encoded-kbd-iso2022-designations + (or (aref encoded-kbd-iso2022-invocations 2) + (aref encoded-kbd-iso2022-invocations 0))))) (aset encoded-kbd-iso2022-invocations 2 nil) - (setq unread-command-events (cons char unread-command-events)))) - -(defun encoded-kbd-self-insert-iso2022-8bit () - (interactive) - (cond - ((= last-command-char ?\216) ; SS2 (Single Shift 2) - (aset encoded-kbd-iso2022-invocations 2 2)) - ((= last-command-char ?\217) ; SS3 (Single Shift 3) - (aset encoded-kbd-iso2022-invocations 2 3)) - (t - (let* ((charset (aref encoded-kbd-iso2022-designations - (or (aref encoded-kbd-iso2022-invocations 2) - (aref encoded-kbd-iso2022-invocations 1)))) - (char (if (= (charset-dimension charset) 1) - (make-char charset last-command-char) - (make-char charset last-command-char - (read-char-exclusive))))) - (aset encoded-kbd-iso2022-invocations 2 nil) - (setq unread-command-events (cons char unread-command-events)))))) - -(defun encoded-kbd-self-insert-sjis () - (interactive) - (let ((char (if (or (< last-command-char ?\xA0) (>= last-command-char ?\xE0)) - (decode-sjis-char (+ (ash last-command-char 8) - (read-char-exclusive))) - (make-char 'katakana-jisx0201 last-command-char)))) - (setq unread-command-events (cons char unread-command-events)))) - -(defun encoded-kbd-self-insert-big5 () - (interactive) - (let ((char (decode-big5-char (+ (ash last-command-char 8) - (read-char-exclusive))))) - (setq unread-command-events (cons char unread-command-events)))) - -(defun encoded-kbd-self-insert-ccl () - (interactive) - (let ((str (char-to-string last-command-char)) + (vector (if (= (charset-dimension charset) 1) + (make-char charset char) + (make-char charset char (read-char-exclusive)))))) + +(defun encoded-kbd-self-insert-iso2022-8bit (ignore) + (let ((char (encoded-kbd-last-key)) + (charset (aref encoded-kbd-iso2022-designations + (or (aref encoded-kbd-iso2022-invocations 2) + (aref encoded-kbd-iso2022-invocations 1))))) + (aset encoded-kbd-iso2022-invocations 2 nil) + (vector (if (= (charset-dimension charset) 1) + (make-char charset char) + (make-char charset char (read-char-exclusive)))))) + +(defun encoded-kbd-self-insert-sjis (ignore) + (let ((char (encoded-kbd-last-key))) + (vector + (if (or (< char ?\xA0) (>= char ?\xE0)) + (decode-sjis-char (+ (ash char 8) (read-char-exclusive))) + (make-char 'katakana-jisx0201 char))))) + +(defun encoded-kbd-self-insert-big5 (ignore) + (let ((char (encoded-kbd-last-key))) + (vector + (decode-big5-char (+ (ash char 8) (read-char-exclusive)))))) + +(defun encoded-kbd-self-insert-ccl (ignore) + (let ((str (char-to-string (encoded-kbd-last-key))) (ccl (car (aref (coding-system-spec (keyboard-coding-system)) 4))) (vec [nil nil nil nil nil nil nil nil nil]) result) (while (= (length (setq result (ccl-execute-on-string ccl vec str t))) 0) (dotimes (i 9) (aset vec i nil)) (setq str (format "%s%c" str (read-char-exclusive)))) - (setq unread-command-events - (append result unread-command-events)))) + (vector (aref result 0)))) (defun encoded-kbd-setup-keymap (coding) ;; At first, reset the keymap. - (setcdr encoded-kbd-mode-map nil) + (define-key encoded-kbd-mode-map "\e" nil) ;; Then setup the keymap according to the keyboard coding system. (cond - ((eq encoded-kbd-coding 'sjis) + ((eq (coding-system-type coding) 1) ; SJIS (let ((i 128)) (while (< i 256) - (define-key encoded-kbd-mode-map + (define-key key-translation-map (vector i) 'encoded-kbd-self-insert-sjis) - (setq i (1+ i))))) + (setq i (1+ i)))) + 8) - ((eq encoded-kbd-coding 'big5) + ((eq (coding-system-type coding) 3) ; Big5 (let ((i 161)) (while (< i 255) - (define-key encoded-kbd-mode-map + (define-key key-translation-map (vector i) 'encoded-kbd-self-insert-big5) - (setq i (1+ i))))) - - ((eq encoded-kbd-coding 'iso2022-7) - (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix)) - - ((eq encoded-kbd-coding 'iso2022-8) - (define-key encoded-kbd-mode-map - (vector ?\216) 'encoded-kbd-self-insert-iso2022-8bit) - (define-key encoded-kbd-mode-map - (vector ?\217) 'encoded-kbd-self-insert-iso2022-8bit) - (let ((i 160)) - (while (< i 256) - (define-key encoded-kbd-mode-map - (vector i) 'encoded-kbd-self-insert-iso2022-8bit) - (setq i (1+ i))))) - - ((eq encoded-kbd-coding 'ccl) + (setq i (1+ i)))) + 8) + + ((eq (coding-system-type coding) 2) ; ISO-2022 + (let ((flags (coding-system-flags coding)) + use-designation) + (if (aref flags 8) + nil ; Don't support locking-shift. + (setq encoded-kbd-iso2022-designations (make-vector 4 nil) + encoded-kbd-iso2022-invocations (make-vector 3 nil)) + (dotimes (i 4) + (if (aref flags i) + (if (charsetp (aref flags i)) + (aset encoded-kbd-iso2022-designations + i (aref flags i)) + (setq use-designation t) + (if (charsetp (car-safe (aref flags i))) + (aset encoded-kbd-iso2022-designations + i (car (aref flags i))))))) + (aset encoded-kbd-iso2022-invocations 0 0) + (if (aref encoded-kbd-iso2022-designations 1) + (aset encoded-kbd-iso2022-invocations 1 1)) + (when use-designation + (define-key encoded-kbd-mode-map "\e" 'encoded-kbd-iso2022-esc-prefix) + (define-key key-translation-map "\e" 'encoded-kbd-iso2022-esc-prefix)) + (when (or (aref flags 2) (aref flags 3)) + (define-key key-translation-map + [?\216] 'encoded-kbd-iso2022-single-shift) + (define-key key-translation-map + [?\217] 'encoded-kbd-iso2022-single-shift)) + (or (eq (aref flags 0) 'ascii) + (dotimes (i 96) + (define-key key-translation-map + (vector (+ 32 i)) 'encoded-kbd-self-insert-iso2022-7bit))) + (if (aref flags 7) + t + (dotimes (i 96) + (define-key key-translation-map + (vector (+ 160 i)) 'encoded-kbd-self-insert-iso2022-8bit)) + 8)))) + + ((eq (coding-system-type coding) 4) ; CCL-base (let ((valid-codes (or (coding-system-get coding 'valid-codes) '((128 . 255)))) - elt from to) + elt from to valid) (while valid-codes (setq elt (car valid-codes) valid-codes (cdr valid-codes)) (if (consp elt) @@ -276,13 +243,17 @@ The following key sequence may cause multilingual text insertion." (setq from (setq to elt))) (while (<= from to) (if (>= from 128) - (define-key encoded-kbd-mode-map + (define-key key-translation-map (vector from) 'encoded-kbd-self-insert-ccl)) - (setq from (1+ from)))))) + (setq from (1+ from)))) + 8)) (t - (error "Invalid value in encoded-kbd-coding: %s" encoded-kbd-coding)))) + nil))) +;; key-translation-map at the time Encoded-kbd mode is turned on is +;; saved here. +(defvar saved-key-translation-map nil) ;; Input mode at the time Encoded-kbd mode is turned on is saved here. (defvar saved-input-mode nil) @@ -301,60 +272,38 @@ In Encoded-kbd mode, a text sent from keyboard is accepted as a multilingual text encoded in a coding system set by \\[set-keyboard-coding-system]." :global t - ;; We must at first reset input-mode to the original. - (if saved-input-mode (apply 'set-input-mode saved-input-mode)) + (if encoded-kbd-mode - (let ((coding (keyboard-coding-system))) - (setq saved-input-mode (current-input-mode)) - (cond ((null coding) - (setq encoded-kbd-mode nil) - (error "No coding system for keyboard input is set")) - - ((= (coding-system-type coding) 1) ; SJIS - (set-input-mode - (nth 0 saved-input-mode) (nth 1 saved-input-mode) - 'use-8th-bit (nth 3 saved-input-mode)) - (setq encoded-kbd-coding 'sjis)) - - ((= (coding-system-type coding) 2) ; ISO2022 - (if (aref (coding-system-flags coding) 7) ; 7-bit only - (setq encoded-kbd-coding 'iso2022-7) - (set-input-mode - (nth 0 saved-input-mode) (nth 1 saved-input-mode) - 'use-8th-bit (nth 3 saved-input-mode)) - (setq encoded-kbd-coding 'iso2022-8)) - (setq encoded-kbd-iso2022-designations (make-vector 4 nil)) - (let ((flags (coding-system-flags coding)) - (i 0)) - (while (< i 4) - (if (charsetp (aref flags i)) - (aset encoded-kbd-iso2022-designations i - (aref flags i)) - (if (charsetp (car-safe (aref flags i))) - (aset encoded-kbd-iso2022-designations i - (car (aref flags i))))) - (setq i (1+ i)))) - (setq encoded-kbd-iso2022-invocations (make-vector 3 nil)) - (aset encoded-kbd-iso2022-invocations 0 0) - (aset encoded-kbd-iso2022-invocations 1 1)) - - ((= (coding-system-type coding) 3) ; BIG5 - (set-input-mode - (nth 0 saved-input-mode) (nth 1 saved-input-mode) - 'use-8th-bit (nth 3 saved-input-mode)) - (setq encoded-kbd-coding 'big5)) - - ((= (coding-system-type coding) 4) ; CCL based coding - (set-input-mode - (nth 0 saved-input-mode) (nth 1 saved-input-mode) - 'use-8th-bit (nth 3 saved-input-mode)) - (setq encoded-kbd-coding 'ccl)) - - (t - (setq encoded-kbd-mode nil) - (error "Coding-system `%s' is not supported in Encoded-kbd mode" - (keyboard-coding-system)))) - (encoded-kbd-setup-keymap coding)))) + ;; We are turning on Encoded-kbd mode. + (let ((coding (keyboard-coding-system)) + result) + (or saved-key-translation-map + (if (keymapp key-translation-map) + (setq saved-key-translation-map + (copy-keymap key-translation-map)) + (setq key-translation-map (make-sparse-keymap)))) + (or saved-input-mode + (setq saved-input-mode + (current-input-mode))) + (setq result (and coding (encoded-kbd-setup-keymap coding))) + (if result + (if (eq result 8) + (set-input-mode + (nth 0 saved-input-mode) + (nth 1 saved-input-mode) + 'use-8th-bit + (nth 3 saved-input-mode))) + (setq encoded-kbd-mode nil + saved-key-translation-map nil + saved-input-mode nil) + (error "Unsupported coding system in Encoded-kbd mode: %S" + coding))) + + ;; We are turning off Encoded-kbd mode. + (setq key-translation-map saved-key-translation-map + saved-key-translation-map nil) + (apply 'set-input-mode saved-input-mode) + (setq saved-input-mode nil))) (provide 'encoded-kb) diff --git a/lisp/international/latin1-disp.el b/lisp/international/latin1-disp.el index a0be6db3d2f..132f11d485b 100644 --- a/lisp/international/latin1-disp.el +++ b/lisp/international/latin1-disp.el @@ -225,7 +225,7 @@ character set: `latin-2', `hebrew' etc." ;; Backwards compatibility. (defalias 'latin1-char-displayable-p 'char-displayable-p) -(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "21.5") +(make-obsolete 'latin1-char-displayable-p 'char-displayable-p "21.4") (defun latin1-display-setup (set &optional force) "Set up Latin-1 display for characters in the given SET. diff --git a/lisp/international/utf-8.el b/lisp/international/utf-8.el index 77a51abb43f..5a7acee0f0e 100644 --- a/lisp/international/utf-8.el +++ b/lisp/international/utf-8.el @@ -273,7 +273,7 @@ The value nil means that the tables are not yet loaded.") (utf-translate-cjk-load-tables)) (gethash code-point (get 'utf-subst-table-for-decode 'translation-hash-table))) - + (defun utf-lookup-subst-table-for-encode (char) (if (and utf-translate-cjk-mode @@ -282,9 +282,11 @@ The value nil means that the tables are not yet loaded.") (utf-translate-cjk-load-tables)) (gethash char (get 'utf-subst-table-for-encode 'translation-hash-table))) - + (define-minor-mode utf-translate-cjk-mode - "Whether the UTF based coding systems should decode/encode CJK characters. + "Toggle whether UTF based coding systems de/encode CJK characters. +If ARG is an integer, enable if ARG is positive and disable if +zero or negative. This is a minor mode. Enabling this allows the coding systems mule-utf-8, mule-utf-16le and mule-utf-16be to encode characters in the charsets `korean-ksc5601', `chinese-gb2312', `chinese-big5-1', @@ -296,9 +298,10 @@ according to the language environment in effect when this option is turned on: ksc5601 for Korean, gb2312 for Chinese-GB, big5 for Chinese-Big5 and jisx for other environments. -This option is on by default. If you are not interested in CJK +This mode is on by default. If you are not interested in CJK characters and want to avoid some overhead on encoding/decoding -by the above coding systems, you can customize this option to nil." +by the above coding systems, you can customize the user option +`utf-translate-cjk-mode' to nil." :init-value t :version "21.4" :type 'boolean @@ -605,7 +608,7 @@ eight-bit-control and eight-bit-graphic characters.") ;; UTF-8 decoder generates an UTF-8 sequence represented by a ;; sequence eight-bit-control/graphic chars for an untranslatable ;; character and an invalid byte. - ;; + ;; ;; This CCL parses that sequence (the first byte is already in r1), ;; writes out the original bytes of that sequence, and sets r5 to ;; -1. @@ -624,7 +627,7 @@ eight-bit-control and eight-bit-graphic characters.") (read-multibyte-character r5 r6) (r0 = (r5 != ,(charset-id 'eight-bit-control))) (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0) - ((write r1) ; invalid UTF-8 + ((write r1) ; invalid UTF-8 (r1 = -1) (end))) @@ -641,7 +644,7 @@ eight-bit-control and eight-bit-graphic characters.") (r1 = -1) ;; Read the 3rd byte. (read-multibyte-character r5 r6) - (r0 = (r5 != ,(charset-id 'eight-bit-control))) + (r0 = (r5 != ,(charset-id 'eight-bit-control))) (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0) (end)) ; invalid UTF-8 (write r6) @@ -651,7 +654,7 @@ eight-bit-control and eight-bit-graphic characters.") (end))) ;; Read the 4th byte. (read-multibyte-character r5 r6) - (r0 = (r5 != ,(charset-id 'eight-bit-control))) + (r0 = (r5 != ,(charset-id 'eight-bit-control))) (if ((r5 != ,(charset-id 'eight-bit-graphic)) & r0) (end)) ; invalid UTF-8 ;; 4-byte sequence for an untranslated character. @@ -867,7 +870,9 @@ Also compose particular scripts if `utf-8-compose-scripts' is non-nil." ;; version of the string in the loop, since it's always loaded as ;; unibyte from a byte-compiled file. (let ((range (string-as-multibyte "^\xc0-\xc3\xe1-\xf7")) + (buffer-multibyte enable-multibyte-characters) hash-table ch) + (set-buffer-multibyte t) (when utf-translate-cjk-mode (if (not utf-translate-cjk-lang-env) ;; Check these characters: @@ -890,7 +895,9 @@ Also compose particular scripts if `utf-8-compose-scripts' is non-nil." (progn (insert ch) (delete-char 1)) - (forward-char 1))))) + (forward-char 1)))) + (or buffer-multibyte + (set-buffer-multibyte nil))) (when (and utf-8-compose-scripts (> length 1)) ;; These currently have definitions which cover the relevant diff --git a/lisp/isearch.el b/lisp/isearch.el index a5261d2530c..9d1e56aaf6e 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -57,47 +57,6 @@ ;; keep the behavior. No point in forcing nonincremental search until ;; the last possible moment. -;; TODO -;; - Integrate the emacs 19 generalized command history. -;; - Hooks and options for failed search. - -;;; Change Log: - -;; Changes before those recorded in ChangeLog: - -;; Revision 1.4 92/09/14 16:26:02 liberte -;; Added prefix args to isearch-forward, etc. to switch between -;; string and regular expression searching. -;; Added some support for lemacs. -;; Added general isearch-highlight option - but only for lemacs so far. -;; Added support for frame switching in emacs 19. -;; Added word search option to isearch-edit-string. -;; Renamed isearch-quit to isearch-abort. -;; Numerous changes to comments and doc strings. -;; -;; Revision 1.3 92/06/29 13:10:08 liberte -;; Moved modal isearch-mode handling into isearch-mode. -;; Got rid of buffer-local isearch variables. -;; isearch-edit-string used by ring adjustments, completion, and -;; nonincremental searching. C-s and C-r are additional exit commands. -;; Renamed all regex to regexp. -;; Got rid of found-start and found-point globals. -;; Generalized handling of upper-case chars. - -;; Revision 1.2 92/05/27 11:33:57 liberte -;; Emacs version 19 has a search ring, which is supported here. -;; Other fixes found in the version 19 isearch are included here. -;; -;; Also see variables search-caps-disable-folding, -;; search-nonincremental-instead, search-whitespace-regexp, and -;; commands isearch-toggle-regexp, isearch-edit-string. -;; -;; semi-modal isearching is supported. - -;; Changes for 1.1 -;; 3/18/92 Fixed invalid-regexp. -;; 3/18/92 Fixed yanking in regexps. - ;;; Code: @@ -153,9 +112,9 @@ string, and RET terminates editing and does a nonincremental search." (defcustom search-whitespace-regexp "\\(?:\\s-+\\)" "*If non-nil, regular expression to match a sequence of whitespace chars. This applies to regular expression incremental search. -You might want to use something like \"[ \\t\\r\\n]+\" instead. -In the Customization buffer, that is `[' followed by a space, -a tab, a carriage return (control-M), a newline, and `]+'." +You might want to use something like \"\\\\(?:[ \\t\\r\\n]+\\\\)\" instead. +In the Customization buffer, that is `\\(?:[' followed by a space, +a tab, a carriage return (control-M), a newline, and `]+\\)'." :type 'regexp :group 'isearch) @@ -198,6 +157,15 @@ Ordinarily the text becomes invisible again at the end of the search." (defvar isearch-mode-end-hook nil "Function(s) to call after terminating an incremental search.") +(defvar isearch-wrap-function nil + "Function to call to wrap the search when search is failed. +If nil, move point to the beginning of the buffer for a forward search, +or to the end of the buffer for a backward search.") + +(defvar isearch-push-state-function nil + "Function to save a function restoring the mode-specific isearch state +to the search status stack.") + ;; Search ring. (defvar search-ring nil @@ -298,11 +266,11 @@ Default value, nil, means edit the string instead." (define-key map "\M-\C-y" 'isearch-yank-char) (define-key map "\C-y" 'isearch-yank-line) - ;; Define keys for regexp chars * ? |. + ;; Define keys for regexp chars * ? } |. ;; Nothing special for + because it matches at least once. (define-key map "*" 'isearch-*-char) (define-key map "?" 'isearch-*-char) - (define-key map "{" 'isearch-{-char) + (define-key map "}" 'isearch-}-char) (define-key map "|" 'isearch-|-char) ;; Turned off because I find I expect to get the global definition--rms. @@ -372,9 +340,9 @@ Default value, nil, means edit the string instead." (defvar isearch-cmds nil "Stack of search status sets. -Each set is a list of the form: - (STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD - INVALID-REGEXP WRAPPED BARRIER WITHIN-BRACKETS CASE-FOLD-SEARCH)") +Each set is a vector of the form: + [STRING MESSAGE POINT SUCCESS FORWARD OTHER-END WORD + INVALID-REGEXP WRAPPED BARRIER WITHIN-BRACKETS CASE-FOLD-SEARCH]") (defvar isearch-string "") ; The current search string. (defvar isearch-message "") ; text-char-description version of isearch-string @@ -774,6 +742,81 @@ REGEXP says which ring to use." ;; (handle-switch-frame (car (cdr last-command-char)))) +;; The search status structure and stack. + +(defsubst isearch-string-state (frame) + "Return the search string in FRAME." + (aref frame 0)) +(defsubst isearch-message-state (frame) + "Return the search string to display to the user in FRAME." + (aref frame 1)) +(defsubst isearch-point-state (frame) + "Return the point in FRAME." + (aref frame 2)) +(defsubst isearch-success-state (frame) + "Return the success flag in FRAME." + (aref frame 3)) +(defsubst isearch-forward-state (frame) + "Return the searching-forward flag in FRAME." + (aref frame 4)) +(defsubst isearch-other-end-state (frame) + "Return the other end of the match in FRAME." + (aref frame 5)) +(defsubst isearch-word-state (frame) + "Return the search-by-word flag in FRAME." + (aref frame 6)) +(defsubst isearch-invalid-regexp-state (frame) + "Return the regexp error message in FRAME, or nil if its regexp is valid." + (aref frame 7)) +(defsubst isearch-wrapped-state (frame) + "Return the search-wrapped flag in FRAME." + (aref frame 8)) +(defsubst isearch-barrier-state (frame) + "Return the barrier value in FRAME." + (aref frame 9)) +(defsubst isearch-within-brackets-state (frame) + "Return the in-character-class flag in FRAME." + (aref frame 10)) +(defsubst isearch-case-fold-search-state (frame) + "Return the case-folding flag in FRAME." + (aref frame 11)) +(defsubst isearch-pop-fun-state (frame) + "Return the function restoring the mode-specific isearch state in FRAME." + (aref frame 12)) + +(defun isearch-top-state () + (let ((cmd (car isearch-cmds))) + (setq isearch-string (isearch-string-state cmd) + isearch-message (isearch-message-state cmd) + isearch-success (isearch-success-state cmd) + isearch-forward (isearch-forward-state cmd) + isearch-other-end (isearch-other-end-state cmd) + isearch-word (isearch-word-state cmd) + isearch-invalid-regexp (isearch-invalid-regexp-state cmd) + isearch-wrapped (isearch-wrapped-state cmd) + isearch-barrier (isearch-barrier-state cmd) + isearch-within-brackets (isearch-within-brackets-state cmd) + isearch-case-fold-search (isearch-case-fold-search-state cmd)) + (if (functionp (isearch-pop-fun-state cmd)) + (funcall (isearch-pop-fun-state cmd) cmd)) + (goto-char (isearch-point-state cmd)))) + +(defun isearch-pop-state () + (setq isearch-cmds (cdr isearch-cmds)) + (isearch-top-state)) + +(defun isearch-push-state () + (setq isearch-cmds + (cons (vector isearch-string isearch-message (point) + isearch-success isearch-forward isearch-other-end + isearch-word + isearch-invalid-regexp isearch-wrapped isearch-barrier + isearch-within-brackets isearch-case-fold-search + (if isearch-push-state-function + (funcall isearch-push-state-function))) + isearch-cmds))) + + ;; Commands active while inside of the isearch minor mode. (defun isearch-exit () @@ -956,10 +999,13 @@ If first char entered is \\[isearch-yank-word-or-char], then do word search inst (defun isearch-cancel () "Terminate the search and go back to the starting point." (interactive) + (if (functionp (isearch-pop-fun-state (car (last isearch-cmds)))) + (funcall (isearch-pop-fun-state (car (last isearch-cmds))) + (car (last isearch-cmds)))) (goto-char isearch-opoint) - (isearch-done t) + (isearch-done t) ; exit isearch (isearch-clean-overlays) - (signal 'quit nil)) ; and pass on quit signal + (signal 'quit nil)) ; and pass on quit signal (defun isearch-abort () "Abort incremental search mode if searching is successful, signaling quit. @@ -971,11 +1017,9 @@ Use `isearch-exit' to quit without signaling." (if isearch-success ;; If search is successful, move back to starting point ;; and really do quit. - (progn (goto-char isearch-opoint) - (setq isearch-success nil) - (isearch-done t) ; exit isearch - (isearch-clean-overlays) - (signal 'quit nil)) ; and pass on quit signal + (progn + (setq isearch-success nil) + (isearch-cancel)) ;; If search is failing, or has an incomplete regexp, ;; rub out until it is once more successful. (while (or (not isearch-success) isearch-invalid-regexp) @@ -1000,7 +1044,9 @@ Use `isearch-exit' to quit without signaling." ;; If already have what to search for, repeat it. (or isearch-success (progn - (goto-char (if isearch-forward (point-min) (point-max))) + (if isearch-wrap-function + (funcall isearch-wrap-function) + (goto-char (if isearch-forward (point-min) (point-max)))) (setq isearch-wrapped t)))) ;; C-s in reverse or C-r in forward, change direction. (setq isearch-forward (not isearch-forward))) @@ -1042,6 +1088,7 @@ Use `isearch-exit' to quit without signaling." (interactive) (setq isearch-regexp (not isearch-regexp)) (if isearch-regexp (setq isearch-word nil)) + (setq isearch-success t isearch-adjusted t) (isearch-update)) (defun isearch-toggle-case-fold () @@ -1054,34 +1101,39 @@ Use `isearch-exit' to quit without signaling." (isearch-message-prefix nil nil isearch-nonincremental) isearch-message (if isearch-case-fold-search "in" ""))) - (setq isearch-adjusted t) + (setq isearch-success t isearch-adjusted t) (sit-for 1) (isearch-update)) -(defun isearch-query-replace () +(defun isearch-query-replace (&optional regexp-flag) "Start query-replace with string to replace from last search string." (interactive) (barf-if-buffer-read-only) + (if regexp-flag (setq isearch-regexp t)) (let ((case-fold-search isearch-case-fold-search)) (isearch-done) (isearch-clean-overlays) - (and isearch-forward isearch-other-end (goto-char isearch-other-end)) + (if (and (< isearch-other-end (point)) + (not (and transient-mark-mode mark-active + (< isearch-opoint (point))))) + (goto-char isearch-other-end)) + (set query-replace-from-history-variable + (cons isearch-string + (symbol-value query-replace-from-history-variable))) (perform-replace isearch-string - (query-replace-read-to isearch-string "Query replace" isearch-regexp) - t isearch-regexp isearch-word))) + (query-replace-read-to + isearch-string + (if isearch-regexp "Query replace regexp" "Query replace") + isearch-regexp) + t isearch-regexp isearch-word nil nil + (if (and transient-mark-mode mark-active) (region-beginning)) + (if (and transient-mark-mode mark-active) (region-end))))) (defun isearch-query-replace-regexp () "Start query-replace-regexp with string to replace from last search string." (interactive) - (let ((query-replace-interactive t) - (case-fold-search isearch-case-fold-search)) - ;; Put search string into the right ring - (setq isearch-regexp t) - (isearch-done) - (isearch-clean-overlays) - (and isearch-forward isearch-other-end (goto-char isearch-other-end)) - (call-interactively 'query-replace-regexp))) + (isearch-query-replace t)) (defun isearch-delete-char () @@ -1249,53 +1301,93 @@ might return the position of the end of the line." (isearch-update)) -(defun isearch-{-char () - "Handle \{ specially in regexps." - (interactive) - (isearch-*-char t)) - -;; *, ?, and | chars can make a regexp more liberal. +;; *, ?, }, and | chars can make a regexp more liberal. ;; They can make a regexp match sooner or make it succeed instead of failing. ;; So go back to place last successful search started ;; or to the last ^S/^R (barrier), whichever is nearer. ;; + needs no special handling because the string must match at least once. -(defun isearch-*-char (&optional want-backslash) - "Handle * and ? specially in regexps. -When WANT-BACKSLASH is non-nil, do special handling for \{." - (interactive) - (if isearch-regexp - (let ((idx (length isearch-string))) - (while (and (> idx 0) - (eq (aref isearch-string (1- idx)) ?\\)) - (setq idx (1- idx))) - ;; * and ? are special when not preceded by \. - ;; { is special when it is preceded by \. - (when (= (mod (- (length isearch-string) idx) 2) - (if want-backslash 1 0)) - (setq isearch-adjusted t) - ;; Get the isearch-other-end from before the last search. - ;; We want to start from there, - ;; so that we don't retreat farther than that. - ;; (car isearch-cmds) is after last search; - ;; (car (cdr isearch-cmds)) is from before it. - (let ((cs (nth 5 (car (cdr isearch-cmds))))) - (setq cs (or cs isearch-barrier)) - (goto-char - (if isearch-forward - (max cs isearch-barrier) - (min cs isearch-barrier))))))) +(defun isearch-backslash (str) + "Return t if STR ends in an odd number of backslashes." + (= (mod (- (length str) (string-match "\\\\*\\'" str)) 2) 1)) + +(defun isearch-fallback (want-backslash &optional allow-invalid to-barrier) + "Return point to previous successful match to allow regexp liberalization. +\\<isearch-mode-map> +Respects \\[isearch-repeat-forward] and \\[isearch-repeat-backward] by +stopping at `isearch-barrier' as needed. + +Do nothing if a backslash is escaping the liberalizing character. If +WANT-BACKSLASH is non-nil, invert this behavior (for \\} and \\|). + +Do nothing if regexp has recently been invalid unless optional ALLOW-INVALID +non-nil. + +If optional TO-BARRIER non-nil, ignore previous matches and go exactly to the +barrier." + ;; (eq (not a) (not b)) makes all non-nil values equivalent + (when (and isearch-regexp (eq (not (isearch-backslash isearch-string)) + (not want-backslash)) + ;; We have to check 2 stack frames because the last might be + ;; invalid just because of a backslash. + (or (not isearch-invalid-regexp) + (not (isearch-invalid-regexp-state (cadr isearch-cmds))) + allow-invalid)) + (if to-barrier + (progn (goto-char isearch-barrier) + (setq isearch-adjusted t)) + (let* ((stack isearch-cmds) + (previous (cdr stack)) ; lookbelow in the stack + (frame (car stack))) + ;; Walk down the stack looking for a valid regexp (as of course only + ;; they can be the previous successful match); this conveniently + ;; removes all bracket-sets and groups that might be in the way, as + ;; well as partial \{\} constructs that the code below leaves behind. + ;; Also skip over postfix operators -- though horrid, + ;; 'ab?\{5,6\}+\{1,2\}*' is perfectly legal. + (while (and previous + (or (isearch-invalid-regexp-state frame) + (let* ((string (isearch-string-state frame)) + (lchar (aref string (1- (length string))))) + ;; The operators aren't always operators; check + ;; backslashes. This doesn't handle the case of + ;; operators at the beginning of the regexp not + ;; being special, but then we should fall back to + ;; the barrier anyway because it's all optional. + (if (isearch-backslash + (isearch-string-state (car previous))) + (eq lchar ?\}) + (memq lchar '(?* ?? ?+)))))) + (setq stack previous previous (cdr previous) frame (car stack))) + (when stack + ;; `stack' now refers the most recent valid regexp that is not at + ;; all optional in its last term. Now dig one level deeper and find + ;; what matched before that. + (let ((last-other-end (or (isearch-other-end-state (car previous)) + isearch-barrier))) + (goto-char (if isearch-forward + (max last-other-end isearch-barrier) + (min last-other-end isearch-barrier))) + (setq isearch-adjusted t)))))) (isearch-process-search-char last-command-char)) +;; * and ? are special when not preceded by \. +(defun isearch-*-char () + "Maybe back up to handle * and ? specially in regexps." + (interactive) + (isearch-fallback nil)) + +;; } is special when it is preceded by \. +(defun isearch-}-char () + "Handle \\} specially in regexps." + (interactive) + (isearch-fallback t t)) +;; | is special when it is preceded by \. (defun isearch-|-char () - "If in regexp search, jump to the barrier." + "If in regexp search, jump to the barrier unless in a group." (interactive) - (if isearch-regexp - (progn - (setq isearch-adjusted t) - (goto-char isearch-barrier))) - (isearch-process-search-char last-command-char)) + (isearch-fallback t nil t)) (defun isearch-unread-key-sequence (keylist) "Unread the given key-sequence KEYLIST. @@ -1534,8 +1626,7 @@ Isearch mode." (let ((ab-bel (isearch-string-out-of-window isearch-point))) (if ab-bel (isearch-back-into-window (eq ab-bel 'above) isearch-point) - (or (eq (point) isearch-point) - (goto-char isearch-point)))) + (goto-char isearch-point))) (isearch-update)) (search-exit-option (let (window) @@ -1775,38 +1866,6 @@ If there is no completion possible, say so and continue searching." (insert isearch-string)))) -;; The search status stack (and isearch window-local variables, not used). -;; Need a structure for this. - -(defun isearch-top-state () - (let ((cmd (car isearch-cmds))) - (setq isearch-string (car cmd) - isearch-message (car (cdr cmd)) - isearch-success (nth 3 cmd) - isearch-forward (nth 4 cmd) - isearch-other-end (nth 5 cmd) - isearch-word (nth 6 cmd) - isearch-invalid-regexp (nth 7 cmd) - isearch-wrapped (nth 8 cmd) - isearch-barrier (nth 9 cmd) - isearch-within-brackets (nth 10 cmd) - isearch-case-fold-search (nth 11 cmd)) - (goto-char (car (cdr (cdr cmd)))))) - -(defun isearch-pop-state () - (setq isearch-cmds (cdr isearch-cmds)) - (isearch-top-state)) - -(defun isearch-push-state () - (setq isearch-cmds - (cons (list isearch-string isearch-message (point) - isearch-success isearch-forward isearch-other-end - isearch-word - isearch-invalid-regexp isearch-wrapped isearch-barrier - isearch-within-brackets isearch-case-fold-search) - isearch-cmds))) - - ;; Message string (defun isearch-message (&optional c-q-hack ellipsis) @@ -1841,7 +1900,9 @@ If there is no completion possible, say so and continue searching." ;; If currently failing, display no ellipsis. (or isearch-success (setq ellipsis nil)) (let ((m (concat (if isearch-success "" "failing ") + (if isearch-adjusted "pending " "") (if (and isearch-wrapped + (not isearch-wrap-function) (if isearch-forward (> (point) isearch-opoint) (< (point) isearch-opoint))) @@ -1936,9 +1997,11 @@ Can be changed via `isearch-search-fun-function' for special needs." (if isearch-success nil ;; Ding if failed this time after succeeding last time. - (and (nth 3 (car isearch-cmds)) + (and (isearch-success-state (car isearch-cmds)) (ding)) - (goto-char (nth 2 (car isearch-cmds))))) + (if (functionp (isearch-pop-fun-state (car isearch-cmds))) + (funcall (isearch-pop-fun-state (car isearch-cmds)) (car isearch-cmds))) + (goto-char (isearch-point-state (car isearch-cmds))))) ;; Called when opening an overlay, and we are still in isearch. diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el index bda0ce4fddc..52915c46950 100644 --- a/lisp/iswitchb.el +++ b/lisp/iswitchb.el @@ -159,7 +159,7 @@ ;; then all buffers matching "Summary" are moved to the end of the ;; list. (I find this handy for keeping the INBOX Summary and so on ;; out of the way.) It also moves buffers matching "output\*$" to the -;; end of the list (these are created by AUC TeX when compiling.) +;; end of the list (these are created by AUCTeX when compiling.) ;; Other functions could be made available which alter the list of ;; matching buffers (either deleting or rearranging elements.) diff --git a/lisp/language/cyrillic.el b/lisp/language/cyrillic.el index dc05f24698a..32ad01602e2 100644 --- a/lisp/language/cyrillic.el +++ b/lisp/language/cyrillic.el @@ -186,6 +186,13 @@ This works whether or not the table is Unicode-based or (define-coding-system-alias 'koi8 'cyrillic-koi8) (define-coding-system-alias 'cp878 'cyrillic-koi8) +(let ((elt `("koi8-r" koi8-r 1 + ,(get 'cyrillic-koi8-r-encode-table 'translation-table))) + (slot (assoc "koi8-r" ctext-non-standard-encodings-alist))) + (if slot + (setcdr slot (cdr elt)) + (push elt ctext-non-standard-encodings-alist))) + ;; Allow displaying some of KOI & al with an 8859-5-encoded font. We ;; won't bother about the exceptions when encoding the font, since ;; NBSP will fall through below and work anyhow, and we'll have @@ -219,6 +226,7 @@ This works whether or not the table is Unicode-based or 'translation-table)) (coding-system cyrillic-koi8) (coding-priority cyrillic-koi8 cyrillic-iso-8bit) + (ctext-non-standard-encodings "koi8-r") (input-method . "russian-typewriter") (features cyril-util) (unibyte-display . cyrillic-koi8) diff --git a/lisp/log-edit.el b/lisp/log-edit.el index 9a4521bbde9..e2d3762ff77 100644 --- a/lisp/log-edit.el +++ b/lisp/log-edit.el @@ -281,19 +281,19 @@ automatically." ;; Compatibility with old names. (defvaralias 'vc-comment-ring 'log-edit-comment-ring) -(make-obsolete-variable 'vc-comment-ring 'log-edit-comment-ring "21.5") +(make-obsolete-variable 'vc-comment-ring 'log-edit-comment-ring "21.4") (defvaralias 'vc-comment-ring-index 'log-edit-comment-ring-index) -(make-obsolete-variable 'vc-comment-ring-index 'log-edit-comment-ring-index "21.5") +(make-obsolete-variable 'vc-comment-ring-index 'log-edit-comment-ring-index "21.4") (defalias 'vc-previous-comment 'log-edit-previous-comment) -(make-obsolete 'vc-previous-comment 'log-edit-previous-comment "21.5") +(make-obsolete 'vc-previous-comment 'log-edit-previous-comment "21.4") (defalias 'vc-next-comment 'log-edit-next-comment) -(make-obsolete 'vc-next-comment 'log-edit-next-comment "21.5") +(make-obsolete 'vc-next-comment 'log-edit-next-comment "21.4") (defalias 'vc-comment-search-reverse 'log-edit-comment-search-backward) -(make-obsolete 'vc-comment-search-reverse 'log-edit-comment-search-backward "21.5") +(make-obsolete 'vc-comment-search-reverse 'log-edit-comment-search-backward "21.4") (defalias 'vc-comment-search-forward 'log-edit-comment-search-forward) -(make-obsolete 'vc-comment-search-forward 'log-edit-comment-search-forward "21.5") +(make-obsolete 'vc-comment-search-forward 'log-edit-comment-search-forward "21.4") (defalias 'vc-comment-to-change-log 'log-edit-comment-to-change-log) -(make-obsolete 'vc-comment-to-change-log 'log-edit-comment-to-change-log "21.5") +(make-obsolete 'vc-comment-to-change-log 'log-edit-comment-to-change-log "21.4") ;;; ;;; Actual code diff --git a/lisp/macros.el b/lisp/macros.el index 72ba3f11721..0de5d223ee0 100644 --- a/lisp/macros.el +++ b/lisp/macros.el @@ -1,6 +1,6 @@ ;;; macros.el --- non-primitive commands for keyboard macros -;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc. +;; Copyright (C) 1985, 86, 87, 92, 94, 95, 04 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: abbrev @@ -151,7 +151,7 @@ use this command, and then save the file." (cond ((= char ?\\) (insert "\\\\")) ((= char ?\") - (insert "\\\"")) + (insert "\\\"")) ((= char ?\;) (insert "\\;")) ((= char 127) @@ -240,8 +240,9 @@ Possibilities: \\<query-replace-map> ;;;###autoload (defun apply-macro-to-region-lines (top bottom &optional macro) - "For each complete line between point and mark, move to the beginning -of the line, and run the last keyboard macro. + "Apply last keyboard macro to all lines in the region. +For each line that begins in the region, move to the beginning of +the line, and run the last keyboard macro. When called from lisp, this function takes two arguments TOP and BOTTOM, describing the current region. TOP must be before BOTTOM. @@ -277,8 +278,7 @@ and write a macro to massage a word into a table entry: \\C-x ) and then select the region of un-tablified names and use -`\\[apply-macro-to-region-lines]' to build the table from the names. -" +`\\[apply-macro-to-region-lines]' to build the table from the names." (interactive "r") (or macro (progn @@ -286,10 +286,7 @@ and then select the region of un-tablified names and use (error "No keyboard macro has been defined")) (setq macro last-kbd-macro))) (save-excursion - (let ((end-marker (progn - (goto-char bottom) - (beginning-of-line) - (point-marker))) + (let ((end-marker (copy-marker bottom)) next-line-marker) (goto-char top) (if (not (bolp)) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index faa7ca1bb74..675444d7ba4 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -687,6 +687,7 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL (defvar disable-initial-guessing-flag) ; dynamic assignment (defvar cbeg) ; dynamic assignment (defvar cend) ; dynamic assignment +(defvar mail-extr-all-top-level-domains) ; Defined below. ;;;###autoload (defun mail-extract-address-components (address &optional all) @@ -1434,374 +1435,388 @@ consing a string.)" (if all (nreverse value-list) (car value-list)) )) +(defcustom mail-extr-disable-voodoo "\\cj" + "*If it is a regexp, names matching it will never be modified. +If it is neither nil nor a string, modifying of names will never take +place. It affects how `mail-extract-address-components' works." + :type '(choice (regexp :size 0) + (const :tag "Always enabled" nil) + (const :tag "Always disabled" t)) + :group 'mail-extr) + (defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer) - (let ((word-count 0) - (case-fold-search nil) - mixed-case-flag lower-case-flag ;;upper-case-flag - suffix-flag last-name-comma-flag - ;;cbeg cend - initial - begin-again-flag - drop-this-word-if-trailing-flag - drop-last-word-if-trailing-flag - word-found-flag - this-word-beg last-word-beg - name-beg name-end - name-done-flag - ) - (save-excursion - (set-syntax-table mail-extr-address-text-syntax-table) - - ;; Get rid of comments. - (goto-char (point-min)) - (while (not (eobp)) - ;; Initialize for this iteration of the loop. - (skip-chars-forward "^({[\"'`") - (let ((cbeg (point))) - (set-syntax-table mail-extr-address-text-comment-syntax-table) - (if (memq (following-char) '(?\' ?\`)) - (search-forward "'" nil 'move - (if (eq ?\' (following-char)) 2 1)) - (or (mail-extr-safe-move-sexp 1) - (goto-char (point-max)))) - (set-syntax-table mail-extr-address-text-syntax-table) - (when (eq (char-after cbeg) ?\() - ;; Delete the comment itself. - (delete-region cbeg (point)) - ;; Canonicalize whitespace where the comment was. - (skip-chars-backward " \t") - (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)") - (replace-match "") - (setq cbeg (point)) - (skip-chars-forward " \t") - (if (bobp) - (delete-region (point) cbeg) - (just-one-space)))))) - - ;; This was moved above. - ;; Fix . used as space - ;; But it belongs here because it occurs not only as - ;; rypens@reks.uia.ac.be (Piet.Rypens) - ;; but also as - ;; "Piet.Rypens" <rypens@reks.uia.ac.be> - ;;(goto-char (point-min)) - ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) - ;; (replace-match "\\1 \\2" t)) - - (unless (search-forward " " nil t) + (unless (and mail-extr-disable-voodoo + (or (not (stringp mail-extr-disable-voodoo)) + (progn + (goto-char (point-min)) + (re-search-forward mail-extr-disable-voodoo nil t)))) + (let ((word-count 0) + (case-fold-search nil) + mixed-case-flag lower-case-flag ;;upper-case-flag + suffix-flag last-name-comma-flag + ;;cbeg cend + initial + begin-again-flag + drop-this-word-if-trailing-flag + drop-last-word-if-trailing-flag + word-found-flag + this-word-beg last-word-beg + name-beg name-end + name-done-flag + ) + (save-excursion + (set-syntax-table mail-extr-address-text-syntax-table) + + ;; Get rid of comments. (goto-char (point-min)) - (cond ((search-forward "_" nil t) - ;; Handle the *idiotic* use of underlines as spaces. - ;; Example: fml@foo.bar.dom (First_M._Last) - (goto-char (point-min)) - (while (search-forward "_" nil t) - (replace-match " " t))) - ((search-forward "." nil t) - ;; Fix . used as space - ;; Example: danj1@cb.att.com (daniel.jacobson) - (goto-char (point-min)) - (while (re-search-forward mail-extr-bad-dot-pattern nil t) - (replace-match "\\1 \\2" t))))) - - ;; Loop over the words (and other junk) in the name. - (goto-char (point-min)) - (while (not name-done-flag) - - (when word-found-flag - ;; Last time through this loop we skipped over a word. - (setq last-word-beg this-word-beg) - (setq drop-last-word-if-trailing-flag - drop-this-word-if-trailing-flag) - (setq word-found-flag nil)) - - (when begin-again-flag - ;; Last time through the loop we found something that - ;; indicates we should pretend we are beginning again from - ;; the start. - (setq word-count 0) - (setq last-word-beg nil) - (setq drop-last-word-if-trailing-flag nil) - (setq mixed-case-flag nil) - (setq lower-case-flag nil) - ;; (setq upper-case-flag nil) - (setq begin-again-flag nil)) - - ;; Initialize for this iteration of the loop. - (mail-extr-skip-whitespace-forward) - (if (eq word-count 0) (narrow-to-region (point) (point-max))) - (setq this-word-beg (point)) - (setq drop-this-word-if-trailing-flag nil) - - ;; Decide what to do based on what we are looking at. - (cond - - ;; Delete title - ((and (eq word-count 0) - (looking-at mail-extr-full-name-prefixes)) - (goto-char (match-end 0)) - (narrow-to-region (point) (point-max))) + (while (not (eobp)) + ;; Initialize for this iteration of the loop. + (skip-chars-forward "^({[\"'`") + (let ((cbeg (point))) + (set-syntax-table mail-extr-address-text-comment-syntax-table) + (if (memq (following-char) '(?\' ?\`)) + (search-forward "'" nil 'move + (if (eq ?\' (following-char)) 2 1)) + (or (mail-extr-safe-move-sexp 1) + (goto-char (point-max)))) + (set-syntax-table mail-extr-address-text-syntax-table) + (when (eq (char-after cbeg) ?\() + ;; Delete the comment itself. + (delete-region cbeg (point)) + ;; Canonicalize whitespace where the comment was. + (skip-chars-backward " \t") + (if (looking-at "\\([ \t]+$\\|[ \t]+,\\)") + (replace-match "") + (setq cbeg (point)) + (skip-chars-forward " \t") + (if (bobp) + (delete-region (point) cbeg) + (just-one-space)))))) + + ;; This was moved above. + ;; Fix . used as space + ;; But it belongs here because it occurs not only as + ;; rypens@reks.uia.ac.be (Piet.Rypens) + ;; but also as + ;; "Piet.Rypens" <rypens@reks.uia.ac.be> + ;;(goto-char (point-min)) + ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t) + ;; (replace-match "\\1 \\2" t)) + + (unless (search-forward " " nil t) + (goto-char (point-min)) + (cond ((search-forward "_" nil t) + ;; Handle the *idiotic* use of underlines as spaces. + ;; Example: fml@foo.bar.dom (First_M._Last) + (goto-char (point-min)) + (while (search-forward "_" nil t) + (replace-match " " t))) + ((search-forward "." nil t) + ;; Fix . used as space + ;; Example: danj1@cb.att.com (daniel.jacobson) + (goto-char (point-min)) + (while (re-search-forward mail-extr-bad-dot-pattern nil t) + (replace-match "\\1 \\2" t))))) - ;; Stop after name suffix - ((and (>= word-count 2) - (looking-at mail-extr-full-name-suffix-pattern)) - (mail-extr-skip-whitespace-backward) - (setq suffix-flag (point)) - (if (eq ?, (following-char)) - (forward-char 1) - (insert ?,)) - ;; Enforce at least one space after comma - (or (eq ?\ (following-char)) - (insert ?\ )) + ;; Loop over the words (and other junk) in the name. + (goto-char (point-min)) + (while (not name-done-flag) + + (when word-found-flag + ;; Last time through this loop we skipped over a word. + (setq last-word-beg this-word-beg) + (setq drop-last-word-if-trailing-flag + drop-this-word-if-trailing-flag) + (setq word-found-flag nil)) + + (when begin-again-flag + ;; Last time through the loop we found something that + ;; indicates we should pretend we are beginning again from + ;; the start. + (setq word-count 0) + (setq last-word-beg nil) + (setq drop-last-word-if-trailing-flag nil) + (setq mixed-case-flag nil) + (setq lower-case-flag nil) + ;; (setq upper-case-flag nil) + (setq begin-again-flag nil)) + + ;; Initialize for this iteration of the loop. (mail-extr-skip-whitespace-forward) - (cond ((memq (following-char) '(?j ?J ?s ?S)) - (capitalize-word 1) - (if (eq (following-char) ?.) - (forward-char 1) - (insert ?.))) - (t - (upcase-word 1))) - (setq word-found-flag t) - (setq name-done-flag t)) - - ;; Handle SCA names - ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As" - (goto-char (match-beginning 1)) - (narrow-to-region (point) (point-max)) - (setq begin-again-flag t)) - - ;; Check for initial last name followed by comma - ((and (eq ?, (following-char)) - (eq word-count 1)) - (forward-char 1) - (setq last-name-comma-flag t) - (or (eq ?\ (following-char)) - (insert ?\ ))) - - ;; Stop before trailing comma-separated comment - ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. - ;; *** This case is redundant??? - ;;((eq ?, (following-char)) - ;; (setq name-done-flag t)) - - ;; Delete parenthesized/quoted comment/nickname - ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) - (setq cbeg (point)) - (set-syntax-table mail-extr-address-text-comment-syntax-table) - (cond ((memq (following-char) '(?\' ?\`)) - (or (search-forward "'" nil t - (if (eq ?\' (following-char)) 2 1)) - (delete-char 1))) - (t - (or (mail-extr-safe-move-sexp 1) - (goto-char (point-max))))) - (set-syntax-table mail-extr-address-text-syntax-table) - (setq cend (point)) + (if (eq word-count 0) (narrow-to-region (point) (point-max))) + (setq this-word-beg (point)) + (setq drop-this-word-if-trailing-flag nil) + + ;; Decide what to do based on what we are looking at. (cond - ;; Handle case of entire name being quoted + + ;; Delete title ((and (eq word-count 0) - (looking-at " *\\'") - (>= (- cend cbeg) 2)) - (narrow-to-region (1+ cbeg) (1- cend)) - (goto-char (point-min))) - (t - ;; Handle case of quoted initial - (if (and (or (= 3 (- cend cbeg)) - (and (= 4 (- cend cbeg)) - (eq ?. (char-after (+ 2 cbeg))))) - (not (looking-at " *\\'"))) - (setq initial (char-after (1+ cbeg))) - (setq initial nil)) - (delete-region cbeg cend) - (if initial - (insert initial ". "))))) - - ;; Handle *Stupid* VMS date stamps - ((looking-at mail-extr-stupid-vms-date-stamp-pattern) - (replace-match "" t)) - - ;; Handle Chinese characters. - ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern) - (goto-char (match-end 0)) - (setq word-found-flag t)) - - ;; Skip initial garbage characters. - ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. - ((and (eq word-count 0) - (looking-at mail-extr-leading-garbage)) - (goto-char (match-end 0)) - ;; *** Skip backward over these??? - ;; (skip-chars-backward "& \"") - (narrow-to-region (point) (point-max))) + (looking-at mail-extr-full-name-prefixes)) + (goto-char (match-end 0)) + (narrow-to-region (point) (point-max))) - ;; Various stopping points - ((or - - ;; Stop before ALL CAPS acronyms, if preceded by mixed-case - ;; words. Example: XT-DEM. - (and (>= word-count 2) - mixed-case-flag - (looking-at mail-extr-weird-acronym-pattern) - (not (looking-at mail-extr-roman-numeral-pattern))) - - ;; Stop before trailing alternative address - (looking-at mail-extr-alternative-address-pattern) - - ;; Stop before trailing comment not introduced by comma - ;; THIS CASE MUST BE AFTER AN EARLIER CASE. - (looking-at mail-extr-trailing-comment-start-pattern) - - ;; Stop before telephone numbers - (and (>= word-count 1) - (looking-at mail-extr-telephone-extension-pattern))) - (setq name-done-flag t)) - - ;; Delete ham radio call signs - ((looking-at mail-extr-ham-call-sign-pattern) - (delete-region (match-beginning 0) (match-end 0))) - - ;; Fixup initials - ((looking-at mail-extr-initial-pattern) - (or (eq (following-char) (upcase (following-char))) - (setq lower-case-flag t)) - (forward-char 1) - (if (eq ?. (following-char)) - (forward-char 1) - (insert ?.)) - (or (eq ?\ (following-char)) - (insert ?\ )) - (setq word-found-flag t)) - - ;; Handle BITNET LISTSERV list names. - ((and (eq word-count 0) - (looking-at mail-extr-listserv-list-name-pattern)) - (narrow-to-region (match-beginning 1) (match-end 1)) - (setq word-found-flag t) - (setq name-done-flag t)) - - ;; Handle & substitution, when & is last and is not first. - ((and (> word-count 0) - (eq ?\ (preceding-char)) - (eq (following-char) ?&) - (eq (1+ (point)) (point-max))) - (delete-char 1) - (capitalize-region - (point) - (progn - (insert-buffer-substring canonicalization-buffer - mbox-beg mbox-end) - (point))) - (setq disable-initial-guessing-flag t) - (setq word-found-flag t)) - - ;; Handle & between names, as in "Bob & Susie". - ((and (> word-count 0) (eq (following-char) ?\&)) - (setq name-beg (point)) - (setq name-end (1+ name-beg)) - (setq word-found-flag t) - (goto-char name-end)) - - ;; Regular name words - ((looking-at mail-extr-name-pattern) - (setq name-beg (point)) - (setq name-end (match-end 0)) - - ;; Certain words will be dropped if they are at the end. - (and (>= word-count 2) - (not lower-case-flag) - (or - ;; Trailing 4-or-more letter lowercase words preceded by - ;; mixed case or uppercase words will be dropped. - (looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'") - ;; Drop a trailing word which is terminated with a period. - (eq ?. (char-after (1- name-end)))) - (setq drop-this-word-if-trailing-flag t)) - - ;; Set the flags that indicate whether we have seen a lowercase - ;; word, a mixed case word, and an uppercase word. - (if (re-search-forward "[[:lower:]]" name-end t) - (if (progn - (goto-char name-beg) - (re-search-forward "[[:upper:]]" name-end t)) - (setq mixed-case-flag t) + ;; Stop after name suffix + ((and (>= word-count 2) + (looking-at mail-extr-full-name-suffix-pattern)) + (mail-extr-skip-whitespace-backward) + (setq suffix-flag (point)) + (if (eq ?, (following-char)) + (forward-char 1) + (insert ?,)) + ;; Enforce at least one space after comma + (or (eq ?\ (following-char)) + (insert ?\ )) + (mail-extr-skip-whitespace-forward) + (cond ((memq (following-char) '(?j ?J ?s ?S)) + (capitalize-word 1) + (if (eq (following-char) ?.) + (forward-char 1) + (insert ?.))) + (t + (upcase-word 1))) + (setq word-found-flag t) + (setq name-done-flag t)) + + ;; Handle SCA names + ((looking-at "MKA \\(.+\\)") ; "Mundanely Known As" + (goto-char (match-beginning 1)) + (narrow-to-region (point) (point-max)) + (setq begin-again-flag t)) + + ;; Check for initial last name followed by comma + ((and (eq ?, (following-char)) + (eq word-count 1)) + (forward-char 1) + (setq last-name-comma-flag t) + (or (eq ?\ (following-char)) + (insert ?\ ))) + + ;; Stop before trailing comma-separated comment + ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. + ;; *** This case is redundant??? + ;;((eq ?, (following-char)) + ;; (setq name-done-flag t)) + + ;; Delete parenthesized/quoted comment/nickname + ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`)) + (setq cbeg (point)) + (set-syntax-table mail-extr-address-text-comment-syntax-table) + (cond ((memq (following-char) '(?\' ?\`)) + (or (search-forward "'" nil t + (if (eq ?\' (following-char)) 2 1)) + (delete-char 1))) + (t + (or (mail-extr-safe-move-sexp 1) + (goto-char (point-max))))) + (set-syntax-table mail-extr-address-text-syntax-table) + (setq cend (point)) + (cond + ;; Handle case of entire name being quoted + ((and (eq word-count 0) + (looking-at " *\\'") + (>= (- cend cbeg) 2)) + (narrow-to-region (1+ cbeg) (1- cend)) + (goto-char (point-min))) + (t + ;; Handle case of quoted initial + (if (and (or (= 3 (- cend cbeg)) + (and (= 4 (- cend cbeg)) + (eq ?. (char-after (+ 2 cbeg))))) + (not (looking-at " *\\'"))) + (setq initial (char-after (1+ cbeg))) + (setq initial nil)) + (delete-region cbeg cend) + (if initial + (insert initial ". "))))) + + ;; Handle *Stupid* VMS date stamps + ((looking-at mail-extr-stupid-vms-date-stamp-pattern) + (replace-match "" t)) + + ;; Handle Chinese characters. + ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern) + (goto-char (match-end 0)) + (setq word-found-flag t)) + + ;; Skip initial garbage characters. + ;; THIS CASE MUST BE AFTER THE PRECEDING CASES. + ((and (eq word-count 0) + (looking-at mail-extr-leading-garbage)) + (goto-char (match-end 0)) + ;; *** Skip backward over these??? + ;; (skip-chars-backward "& \"") + (narrow-to-region (point) (point-max))) + + ;; Various stopping points + ((or + + ;; Stop before ALL CAPS acronyms, if preceded by mixed-case + ;; words. Example: XT-DEM. + (and (>= word-count 2) + mixed-case-flag + (looking-at mail-extr-weird-acronym-pattern) + (not (looking-at mail-extr-roman-numeral-pattern))) + + ;; Stop before trailing alternative address + (looking-at mail-extr-alternative-address-pattern) + + ;; Stop before trailing comment not introduced by comma + ;; THIS CASE MUST BE AFTER AN EARLIER CASE. + (looking-at mail-extr-trailing-comment-start-pattern) + + ;; Stop before telephone numbers + (and (>= word-count 1) + (looking-at mail-extr-telephone-extension-pattern))) + (setq name-done-flag t)) + + ;; Delete ham radio call signs + ((looking-at mail-extr-ham-call-sign-pattern) + (delete-region (match-beginning 0) (match-end 0))) + + ;; Fixup initials + ((looking-at mail-extr-initial-pattern) + (or (eq (following-char) (upcase (following-char))) (setq lower-case-flag t)) -;; (setq upper-case-flag t) - ) + (forward-char 1) + (if (eq ?. (following-char)) + (forward-char 1) + (insert ?.)) + (or (eq ?\ (following-char)) + (insert ?\ )) + (setq word-found-flag t)) + + ;; Handle BITNET LISTSERV list names. + ((and (eq word-count 0) + (looking-at mail-extr-listserv-list-name-pattern)) + (narrow-to-region (match-beginning 1) (match-end 1)) + (setq word-found-flag t) + (setq name-done-flag t)) + + ;; Handle & substitution, when & is last and is not first. + ((and (> word-count 0) + (eq ?\ (preceding-char)) + (eq (following-char) ?&) + (eq (1+ (point)) (point-max))) + (delete-char 1) + (capitalize-region + (point) + (progn + (insert-buffer-substring canonicalization-buffer + mbox-beg mbox-end) + (point))) + (setq disable-initial-guessing-flag t) + (setq word-found-flag t)) + + ;; Handle & between names, as in "Bob & Susie". + ((and (> word-count 0) (eq (following-char) ?\&)) + (setq name-beg (point)) + (setq name-end (1+ name-beg)) + (setq word-found-flag t) + (goto-char name-end)) + + ;; Regular name words + ((looking-at mail-extr-name-pattern) + (setq name-beg (point)) + (setq name-end (match-end 0)) + + ;; Certain words will be dropped if they are at the end. + (and (>= word-count 2) + (not lower-case-flag) + (or + ;; Trailing 4-or-more letter lowercase words preceded by + ;; mixed case or uppercase words will be dropped. + (looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'") + ;; Drop a trailing word which is terminated with a period. + (eq ?. (char-after (1- name-end)))) + (setq drop-this-word-if-trailing-flag t)) + + ;; Set the flags that indicate whether we have seen a lowercase + ;; word, a mixed case word, and an uppercase word. + (if (re-search-forward "[[:lower:]]" name-end t) + (if (progn + (goto-char name-beg) + (re-search-forward "[[:upper:]]" name-end t)) + (setq mixed-case-flag t) + (setq lower-case-flag t)) + ;; (setq upper-case-flag t) + ) - (goto-char name-end) - (setq word-found-flag t)) + (goto-char name-end) + (setq word-found-flag t)) - ;; Allow a number as a word, if it doesn't mean anything else. - ((looking-at "[0-9]+\\>") - (setq name-beg (point)) - (setq name-end (match-end 0)) + ;; Allow a number as a word, if it doesn't mean anything else. + ((looking-at "[0-9]+\\>") + (setq name-beg (point)) + (setq name-end (match-end 0)) + (goto-char name-end) + (setq word-found-flag t)) + + (t + (setq name-done-flag t) + )) + + ;; Count any word that we skipped over. + (if word-found-flag + (setq word-count (1+ word-count)))) + + ;; If the last thing in the name is 2 or more periods, or one or more + ;; other sentence terminators (but not a single period) then keep them + ;; and the preceding word. This is for the benefit of whole sentences + ;; in the name field: it's better behavior than dropping the last word + ;; of the sentence... + (if (and (not suffix-flag) + (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) + (goto-char (setq suffix-flag (point-max)))) + + ;; Drop everything after point and certain trailing words. + (narrow-to-region (point-min) + (or (and drop-last-word-if-trailing-flag + last-word-beg) + (point))) + + ;; Xerox's mailers SUCK!!!!!! + ;; We simply refuse to believe that any last name is PARC or ADOC. + ;; If it looks like that is the last name, that there is no meaningful + ;; here at all. Actually I guess it would be best to map patterns + ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't + ;; actually know that that is what's going on. + (unless suffix-flag + (goto-char (point-min)) + (let ((case-fold-search t)) + (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") + (erase-buffer)))) + + ;; If last name first put it at end (but before suffix) + (when last-name-comma-flag + (goto-char (point-min)) + (search-forward ",") + (setq name-end (1- (point))) + (goto-char (or suffix-flag (point-max))) + (or (eq ?\ (preceding-char)) + (insert ?\ )) + (insert-buffer-substring (current-buffer) (point-min) name-end) (goto-char name-end) - (setq word-found-flag t)) - - (t - (setq name-done-flag t) - )) - - ;; Count any word that we skipped over. - (if word-found-flag - (setq word-count (1+ word-count)))) - - ;; If the last thing in the name is 2 or more periods, or one or more - ;; other sentence terminators (but not a single period) then keep them - ;; and the preceding word. This is for the benefit of whole sentences - ;; in the name field: it's better behavior than dropping the last word - ;; of the sentence... - (if (and (not suffix-flag) - (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'")) - (goto-char (setq suffix-flag (point-max)))) - - ;; Drop everything after point and certain trailing words. - (narrow-to-region (point-min) - (or (and drop-last-word-if-trailing-flag - last-word-beg) - (point))) - - ;; Xerox's mailers SUCK!!!!!! - ;; We simply refuse to believe that any last name is PARC or ADOC. - ;; If it looks like that is the last name, that there is no meaningful - ;; here at all. Actually I guess it would be best to map patterns - ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't - ;; actually know that that is what's going on. - (unless suffix-flag - (goto-char (point-min)) - (let ((case-fold-search t)) - (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'") - (erase-buffer)))) + (skip-chars-forward "\t ,") + (narrow-to-region (point) (point-max))) - ;; If last name first put it at end (but before suffix) - (when last-name-comma-flag + ;; Delete leading and trailing junk characters. + ;; *** This is probably completely unneeded now. + ;;(goto-char (point-max)) + ;;(skip-chars-backward mail-extr-non-end-name-chars) + ;;(if (eq ?. (following-char)) + ;; (forward-char 1)) + ;;(narrow-to-region (point) + ;; (progn + ;; (goto-char (point-min)) + ;; (skip-chars-forward mail-extr-non-begin-name-chars) + ;; (point))) + + ;; Compress whitespace (goto-char (point-min)) - (search-forward ",") - (setq name-end (1- (point))) - (goto-char (or suffix-flag (point-max))) - (or (eq ?\ (preceding-char)) - (insert ?\ )) - (insert-buffer-substring (current-buffer) (point-min) name-end) - (goto-char name-end) - (skip-chars-forward "\t ,") - (narrow-to-region (point) (point-max))) - - ;; Delete leading and trailing junk characters. - ;; *** This is probably completely unneeded now. - ;;(goto-char (point-max)) - ;;(skip-chars-backward mail-extr-non-end-name-chars) - ;;(if (eq ?. (following-char)) - ;; (forward-char 1)) - ;;(narrow-to-region (point) - ;; (progn - ;; (goto-char (point-min)) - ;; (skip-chars-forward mail-extr-non-begin-name-chars) - ;; (point))) - - ;; Compress whitespace - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]+" nil t) - (replace-match (if (eobp) "" " ") t)) - ))) + (while (re-search-forward "[ \t\n]+" nil t) + (replace-match (if (eobp) "" " ") t)) + )))) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index bdf04be519a..f8e31dfda04 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -484,7 +484,7 @@ the variable `rmail-mime-feature'.") ;;;###autoload (defvar rmail-mime-charset-pattern - "^content-type:[ ]*text/plain;[ \t\n]*charset=\"?\\([^ \t\n\"]+\\)\"?" + "^content-type:[ ]*text/plain;[ \t\n]*charset=\"?\\([^ \t\n\";]+\\)\"?" "Regexp to match MIME-charset specification in a header of message. The first parenthesized expression should match the MIME-charset name.") diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 826cf89bfec..b2694bc2b78 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -209,7 +209,7 @@ loaddefs.el-CMD: echo (autoload 'define-derived-mode "derived")>> $@ echo (autoload 'encoded-kbd-mode "encoded-kb")>> $@ echo (defvar cvs-global-menu nil)>> $@ - echo. >> $@ + echo ;;; >> $@ echo ;;; Local Variables:>> $@ echo ;;; version-control: never>> $@ echo ;;; no-byte-compile: t>> $@ diff --git a/lisp/mh-e/ChangeLog b/lisp/mh-e/ChangeLog index 3d19028b099..dd1062da816 100644 --- a/lisp/mh-e/ChangeLog +++ b/lisp/mh-e/ChangeLog @@ -1,3 +1,311 @@ +2004-08-21 Bill Wohler <wohler@newt.com> + + * Released MH-E version 7.82. + + * MH-E-NEWS, README: Updated for release 7.82. + + * mh-e.el (Version, mh-version): Updated for release 7.82. + +2004-08-24 Bill Wohler <wohler@newt.com> + + * mh-init.el (mh-variant-set): Changed MH to mh as that's what is + emitted by `mh-variant-mh-info' (closes SF #1014781). + (mh-variant-p): Added mu-mh to docstring. + +2004-08-23 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-acros.el (mh-require-cl): Remove unneeded autoloads. + (require): Add an advice to the function so that at compile time + the uncompiled file is loaded. This avoids compilation problems + when built in the Emacs tree. + + * mh-mime.el (mh-identity-pgg-default-user-id): Defvar the + variable, to avoid compiler warnings. + + * mh-e.el (mh-seq): Load mh-seq since functions defined there are + used here. Without this, the state mh-seq.elc would be loaded. + + * mh-customize.el (mh-init, mh-identity): Load mh-init and + mh-identity at compile time manually, before the corresponding + stale elc files get autoloaded. + +2004-08-21 Bill Wohler <wohler@newt.com> + + * mh-e.el (Version, mh-version): Added +cvs to release number. + +2004-08-21 Bill Wohler <wohler@newt.com> + + * Released MH-E version 7.81. + + * MH-E-NEWS, README: Updated for release 7.81. + + * mh-e.el (Version, mh-version): Updated for release 7.81. + +2004-08-21 Bill Wohler <wohler@newt.com> + + * release-utils (variable_changes): Check for checked-out + directory before proceeding. Remove temporary files. Renamed + --variable-update flag to --variable-changes. + +2004-08-16 Mark D. Baushke <mdb@gnu.org> + + * mh-mime.el (mh-toggle-mh-decode-mime-flag: New function. + * mh-e.el (mh-help-messages): Add [;] help string for it. + (mh-folder-mode-map): Add ";" key binding for it. + +2004-08-15 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-acros.el (mh-defstruct): Distinguishing structures created + by mh-defstruct just based on the number of fields is not + sufficient, since both the mh-thread-message and + mh-thread-container structures have the same length. + +2004-08-15 Mark D. Baushke <mdb@gnu.org> + + * mh-customize.el (mh-identity-handlers): Use ":default" instead of + "default" to avoid problems with "Default:" as a user defined field. + * mh-identity.el (mh-identity-field-handler): Ditto. + +2004-08-15 Bill Wohler <wohler@newt.com> + + * mh-e.el (Version, mh-version): Added +cvs to release number. + +2004-08-15 Bill Wohler <wohler@newt.com> + + * Released MH-E version 7.4.80. + + * MH-E-NEWS, README: Updated for release 7.4.80. + + * mh-e.el (Version, mh-version): Updated for release 7.4.80. + +2004-08-15 Bill Wohler <wohler@newt.com> + + * mh-funcs.el, mh-gnus.el, mh-inc.el, mh-init.el, mh-junk.el, + mh-pick.el, mh-print.el, mh-xemacs.el: Added 2004 to Copyright. + + * mh-acros.el, mh-alias.el: Checkdoc fixes. + +2004-08-12 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-acros.el (cl): Load cl in this file. That is all right, since + this file is only used at compile time, and so cl doesn't get + loaded at run time. This avoids problems with stale *.elc files + present in the Emacs source tree during compilation. + (mh-defstruct): Modify it to make it more CL like and in the + process simplify it a bit. This makes the argument list of the + constructor compatible with the previous version, thereby avoiding + a compilation error when an old version of mh-seq.elc is present. + + * mh-seq.el (mh-thread-id-container, mh-thread-get-message) + (mh-thread-get-message-container): Revert back to the CL style + of using keyword arguments, since the mh-defstruct now produces + code compatible to such usage. + +2004-08-11 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-acros.el (mh-defstruct, mh-require-cl): Checkdoc fixes. + + * mh-utils.el (message-tokenize-header, message-fetch-field): Add + autoloads. + (mh-folder-completing-read): Make the folder completion look + better with CVS Emacs. + + * mh-init.el (mh-variant-set): Remove dead code. + +2004-08-11 Bill Wohler <wohler@newt.com> + + * *.el: Use the following at the top of each file which seems to + do a good job of suppressing compilation warnings in 21.3 and CVS + Emacs (21.4). This replaces (require 'cl) or (require + 'utils) (mh-require-cl) calls: + + (eval-when-compile (require 'mh-acros)) + (mh-require-cl) + +2004-08-10 Bill Wohler <wohler@newt.com> + + * release-utils (DESCRIPTION): Added one. + (FILES, SEE ALSO, VERSION): Deleted empty and incorrect sections. + + * mh-e.el (mh-colors-available-p): Call x-display-color-cells with + mh-funcall-if-exists since it no longer seems to be defined in + GNU Emacs 21.4. + +2004-08-10 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-speed.el (mh-process-kill-without-query, mh-speed-flists): + Avoid a compiler warning in versions of Emacs where + process-kill-without-query is a deprecated function. + + * mh-seq.el (mh-thread-message, mh-thread-container): Use + mh-defstruct instead of defstruct. + (mh-thread-id-container, mh-thread-get-message-container) + (mh-thread-get-message): Use the slightly different structure + constructor function. + + * mh-acros.el (mh-defstruct): New macro which is a partial + replacement of the defstruct in CL. + (no-byte-compile): Don't compile the file since it isn't loaded at + run time, so efficiency isn't an issue. + + * mh-utils.el (mh-buffer-data): Use mh-defstruct instead of + defstruct. + +2004-08-09 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-funcs.el, mh-junk.el, mh-print.el: Use mh-require-cl to avoid + compilation warnings in Emacs-21.3. + + * mh-acros.el (mh-require-cl): Add autoloads of CL functions used. + +2004-08-09 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-show-use-xface-flag): Mention that `fetch' and + `curl' are supported as well. + +2004-08-08 Bill Wohler <wohler@newt.com> + + * mh-xemacs.el (mh-xemacs-has-toolbar-flag): Checkdoc fixes. + + * mh-mime.el (mh-display-with-external-viewer): Checkdoc fixes. + + * mh-identity.el: (mh-identity-attribution-verb-end): Stripped + trailing space; checkdoc fixes. + + * mh-e.el (mh-restore-desktop-buffer): Checkdoc fixes. + + * mh-customize.el: (mh-inc-spool-list, + mh-compose-forward-as-mime-flag, defcustom): Stripped trailing + space; checkdoc fixes. + + * mh-comp.el (mh-reply): Stripped trailing space. + + * mh-unit.el (mh-unit-files): Added mh-acros.el and mh-gnus.el. + (mh-unit): Don't lm-verify pre-21.4. Save buffers before killing + since we might have done some editing. + + * import-emacs: Deleted. Functionality subsumed by release-utils. + + * release-utils: New script. Performs import-emacs functionality + and displays new and deleted options. + + * Makefile (import-emacs): Call release-utils instead of + import-emacs. + + * mh-funcs.el (mh-undo-folder): Removed deprecated `ignore' + argument. + + * mh-e.el (mh-scan-date-regexp): Deleted as Peter claims it is + obsolete. + (mh-folder-font-lock-keywords): Removed reference to deleted + variable `mh-scan-date-regexp'. + + * mh-customize.el (mh-auto-fields-prompt-flag): Made reference to + `mh-auto-fileds-lists'. + (mh-forward-hook): Fixed docstring typo. + +2004-08-07 Bill Wohler <wohler@newt.com> + + * mh-acros.el: New file. Currently holds macros needed by + mh-customize.el but is planned to hold all macros to avoid + dependency problems when compiling. + + * mh-utils.el (mh-xemacs-flag): Defined in mh-customize.el now. + (mh-require-cl, mh-do-in-gnu-emacs, mh-do-in-xemacs) + (mh-funcall-if-exists, mh-make-local-hook, mh-mark-active-p): + Moved to new file mh-acros.el. + + * mh-customize.el: Require mh-acros and cl only when compiling and + mh-loaddefs at runtime instead of mh-utils. + (mh-xemacs-flag): Define it here instead of mh-utils.el. + + * Makefile (MH-E-SRC): Added mh-acros.el. + + * mh-gnus.el (default-enable-multibyte-characters): Don't define + any more. It doesn't seem to be needed. + + * mh-customize.el (mh-junk-background): New variable. If on, spam + programs are run in background. Running in foreground can be slow. + Defaults to nil to spare machines with little memory. + + * mh-junk.el (mh-spamassassin-blacklist, mh-bogofilter-blacklist) + (mh-bogofilter-whitelist, mh-spamprobe-blacklist) + (mh-spamprobe-whitelist): Use new option mh-junk-background. + +2004-07-25 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-utils.el (mh-folder-completing-read): In recent CVS Emacs, + the first letter of the possible choices in the completion buffer + is highlighted. The change is needed for this feature to work + during folder name completion. This is not entirely sufficient, + since the leading "+" in folder names is still mishandled. A patch + is required in Emacs itself to address that. + +2004-07-22 Mark D. Baushke <mdb@gnu.org> + + * mh-e.el (recursive-load-depth-limit): Move + recursive-load-depth-limit code to ... + * mh-utils.el (recursive-load-depth-limit): ... here to avoid + problems compiling mh-utils.el and mh-alias.el with gnus-5.10.6 + under emacs-21.1. Use eval-and-compile instead of eval-when. + +2004-07-20 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-invisible-header-fields-internal): Added + header fields emitted by T-Mobile picture phones (X-Mms-*, and + commented out X-Operator field saying it's like X-Mailer). + +2004-07-12 Bill Wohler <wohler@newt.com> + + * mh-gnus.el: Set local variables indent-tabs-mode and + sentence-end-double-space to nil. + + * mh-customize.el: Checkpoint from option docstring updates and + manual synchronization from last summer. For the options listed + below, docstring was usually completely rewritten. Use "on" + instead of "t" in docstring to match what is seen in customization + buffer. Use headline capitalization. Standardize on "Auto-detect" + text when option has that capibility. + (mh): Since we work on more than one type of Emacs, use Emacs + instead of GNU Emacs. Prefer GNU mailutils over GNU Mailutils. + (mh-variant): s/Autodetect at startup/Auto-detect/. + (mh-alias-insertion-location): s/Sorted + alphabetically/Alphabetical/. s/At the top of file/Top/. s/At the + bottom of file/Bottom/. + (mh-alias-local-users-prefix): s/Use login instead of real + name/Use Login/. + (mh-identity-list): Sorted values by fields, attribution, + signature, GPG key. + (mh-auto-fields-list): Missing quote. + (mh-compose-insertion): s/Use Gnus/Gnus/. s/Use mhn/mhn/. + (mh-compose-space-does-completion-flag): s/SPACE/<SPC>/. + (mh-extract-from-attribution-verb): Since we have French, added + German too ;-). + (mh-letter-complete-function): Mention default in docstring. + (mh-invisible-header-fields-internal): Added X-ELNK-Trace from + Earthlink. + (mh-alias-flash-on-comma, mh-alias-insert-file) + (mh-alias-passwd-gecos-comma-separator-flag) + (mh-recenter-summary-flag, mh-default-folder-for-message-function) + (mh-default-folder-must-exist-flag, mh-index-program) + (mh-index-ticked-messages-folders, mh-ins-buf-prefix) + (mh-delete-yanked-msg-window-flag, mh-identity-default): See + summary above. + + * mh-init.el (mh-variant-set, mh-sys-path, mh-variant-mu-mh-info): + Prefer GNU mailutils over GNU Mailutils MH. + + * mh-comp.el (sc-cite-original, mh-smail, mh-smail-batch) + (mh-edit-again, mh-extract-rejected-mail, mh-forward) + (mh-smail-other-window, mh-reply, mh-send, mh-send-other-window): + Use `mh-send' instead of \\[mh-send]] since links in the docstring + are more useful than a key sequence in these cases. Use "See also" + instead of "See also documentation for". + + * Merged in 7.4.4 changes, described below. + + * mh-e.el (Version, mh-version): Set to 7.4.4+cvs. + 2004-07-10 Bill Wohler <wohler@newt.com> * Released MH-E version 7.4.4. @@ -66,7 +374,7 @@ require that the cl package not be required at runtime. However, the cl package in versions of Emacs prior to 21.4 left cl routines in their macro expansions. Use mh-require-cl to provide the cl - routines in the best way possible. + routines in the best way possible (closes SF #930012). (require 'mouse): To shush compiler. * Use new function mh-require-cl throughout. @@ -87,6 +395,128 @@ 4. Run xbmtopbm < file.xbm > file.pbm. Thanks to jan.h.d@swipnet.se for the help. +2004-07-07 Stephen Gildea + + * mh-customize.el (mh-invisible-header-fields-internal): + Add X-Greylist, X-Source*, and X-WebTV-Signature. + Replace specific X-Spam-* headers with general pattern. + +2004-06-15 Bill Wohler <wohler@newt.com> + + * README: Vladimir Ivanovic reports that mh-rmail works with + XEmacs 21.5.17, so updated requirements text accordingly (closes + SF #644321). + +2004-05-12 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-utils.el (mh-mail-header-end): Replace call to + rfc822-goto-eoh with something that allows From_ lines in the mail + header. + +2004-04-14 Bill Wohler <wohler@newt.com> + + * mh-utils.el (mh-show-mouse): s/EVENT/event/. Thanks to John Paul + Wallington <jpw@gnu.org> for pointing this out. + +2004-04-12 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-e.el (mh-folder-size-flist): Add -showzero option so that the + parsing code doesn't get confused by the presence of -noshowzero + in the user's .mh_profile (closes SF #933954). + +2004-04-07 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-mime.el (mh-insert-mime-button) + (mh-insert-mime-security-button): Add evaporate property to + overlays used in MIME part buttons. This avoids problems with + CVS Emacs. + +2004-03-16 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-e.el (mh-folder-from-address): Go to the end of buffer if the + re-search-forward fails (closes SF #917096). + +2004-02-02 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-customize.el (mh-compose-forward-as-mime-flag): New user + customizable variable that controls whether messages are forwarded + as MIME attachments (closes SF #827203). + + * mh-comp.el (mh-forward): Call forw with -mime option only if + mh-compose-forward-as-mime-flag is non-nil. + +2003-12-26 Jeffrey C Honig <jch@honig.net> + + * mh-junk.el (mh-junk-blacklist, mh-junk-whitelist) + (mh-spamassassin-blacklist, mh-spamassassin-blacklist) + (mh-spamassassin-blacklist, mh-spamassassin-whitelist) + (mh-spamassassin-whitelist, mh-bogofilter-blacklist) + (mh-spamprobe-blacklist): Add progress messages. Change "Couldn't" + to "Unable" in error messages. Run bogofilter and spamprobe in + the foreground to prevent a large number of processes from + swamping the system. + +2003-12-25 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-e.el (mh-prompt-for-refile-folder): Marking the whole folder + and then refiling all messages throws an error, since this + function expects point to be on a valid scan line. The change + relaxes this requirement, thereby avoiding the above problem. + +2003-12-14 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-comp.el (mh-ascii-buffer-p): New function that checks if a + buffer is entirely composed of ASCII. + (mh-send-letter): Encode the draft if it contains non-ASCII + characters. + +2003-12-12 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-customize.el (mh-invisible-headers): Keep only unique fields + in list of header fields to hide. This avoids problems in XEmacs. + +2003-12-10 Satyaki Das <satyaki@theforce.stanford.edu> + + * mh-seq.el (mh-thread-print-scan-lines): The imenu index was not + getting created for threaded index buffers. The change fixes this. + + * mh-index.el (mh-index-insert-folder-headers): Always create the + imenu index. + (mh-index-create-imenu-index): Set which-func-mode to t. If + which-function-mode is turned on after the folder buffer has been + prepared, display of the folder info was being inhibited. The + change fixes that. + +2003-12-09 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-letter-mode): Setup mh-mail-header-separator + based on draft contents. + (mh-letter-mode, mh-letter-mail-header-end-marker) + (mh-letter-header-end): Remove use of the variable + mh-letter-mail-header-end-marker. Instead use + mh-mail-header-separator. This avoids problems in font locking + draft buffers (closes SF #855479). + +2003-12-09 Satyaki Das <satyakid@stanford.edu> + + * mh-index.el (mh-index-insert-folder-headers): Modified so that + imenu--index-alist is updated. + (mh-index-create-imenu-index): New function that generates an + index usable by imenu. This adds which-func-mode support to index + folders (closes SF #855520). + + * mh-e.el (which-func, which-func-modes): Tell which-func that + mh-folder-mode supports it. + (mh-folder-mode): Add support for imenu. + +2003-11-22 Peter S Galbraith <psg@debian.org> + + * Makefile: renamed mh-startup.el to mh-e-autoloads.el + + * README: renamed mh-startup.el to mh-e-autoloads.el + + * .cvsignore: Added mh-e-autoloads.el + 2003-11-18 Bill Wohler <wohler@newt.com> * Released MH-E version 7.4.3. @@ -95,6 +525,8 @@ * mh-e.el (Version, mh-version): Updated for release 7.4.3. + * This patch release contains the following two patches: + * mh-identity.el (mh-identity-make-menu): Removed condition on mh-auto-fields-list. Use it to enable or disable menu item instead. @@ -103,6 +535,810 @@ defcustom before mh-auto-fields-list so that defvar wouldn't clobber user's customization settings. +2003-11-17 Jeffrey C Honig <jch@honig.net> + + * mh-print.el (mh-print-msg): Do not print a message on deprecated + usage, the bindings have been removed. + + * mh-e.el (mh-folder-mode-map): Remove "l" binding for + mh-print-msg. + + * mh-utils.el (mh-show-mode-map): Remove "l" binding for + mh-print-msg. + +2003-11-16 Satyaki Das <satyakid@stanford.edu> + + * mh-comp.el (mh-beginning-of-word): Use the function + mh-mail-abbrev-make-syntax-table instead of the function + mail-abbrev-make-syntax-table. + + * mh-gnus.el (mh-mail-abbrev-make-syntax-table): Add a wrapper + function that calls mail-abbrev-make-syntax-table if available. + This is needed so that MH-E built with CVS Emacs will work with + released versions of Emacs21 and vice versa. + +2003-11-14 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mh-invisible-header-fields-internal): Add + "X-NAI-Spam-" and "X-Spam-Report:". + +2003-11-14 Mark D. Baushke <mdb@gnu.org> + + * mh-customize.el (mh-invisible-header-fields-internal): + Add X-AntiAbuse and X-MailScanner. + (Patch from Stephen Gildea.) + +2003-11-13 Peter S Galbraith <psg@debian.org> + + * mh-identity.el (mh-identity-handler-attribution-verb): New + function. A new Identity handler for the attribution verb (e.g. + "wrote:") to allow for different identities to use different + languages. + (mh-identity-insert-attribution-verb): New function. Insert the + attribution verb, placing special markers so it can be deleted and + replaced later. + (mh-identity-attribution-verb-start): New variable. Holds the + marker for the start of the attribution verb. + (mh-identity-attribution-verb-end): New variable. Holds the + marker for the end of the attribution verb. + + * mh-customize.el (mh-identity-handlers): Add new + ":attribution-verb" tag for the attribution-verb handler. + (mh-identity-list): Idem. + + * mh-comp.el (mh-yank-cur-msg): Insert attribution verb using + mh-identity-insert-attribution-verb. + (mh-extract-from-attribution): Extract only the name from the From + line, without appending `mh-extract-from-attribution-verb' since + markers need to be inserted around that now. + +2003-11-12 Bill Wohler <wohler@newt.com> + + * mh-e.el (mh-rmail, mh-nmail): Well, actually, we run in both GNU + Emacs and XEmacs, so removed the "GNU" in the docstrings unless + one is strictly talking about GNU Emacs. + + * mh-comp.el (mh-smail, mh-smail-batch, mh-smail-other-window): + Ditto. + +2003-11-11 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-customize): Minor docstring change. + (mh, mh-e): The short description for MH-E is: The GNU Emacs + Interface to the MH Mail System. Therefore, updated docstrings + accordingly. + + * mh-comp.el (mh-smail, mh-smail-batch, mh-smail-other-window): + Ditto. + + * mh-e.el (mh-rmail, mh-nmail): Ditto. + +2003-11-10 Satyaki Das <satyakid@stanford.edu> + + * mh-mime.el (mh-mml-to-mime): In case errors happen in + mml-to-mime, restore contents of the draft buffer (closes SF + #839303). + +2003-11-07 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-letter-mode-hook): Moved to mh-sending-mail + group (where it is now documented in the manual). + (mh-pick-mode-hook): Moved to mh-index group (where it is now + documented in the manual). + + * mh-loaddefs.el: Deleted per our discussion on mh-e-devel. No + more conflicts! No more check-ins! Anyone pulling CVS MH-E is + expected to compile. This file shall be added to the tarball so + that users of the distribution are not. + +2003-11-07 Mark D. Baushke <mdb@gnu.org> + + * mh-loaddefs.el: Regenerated. + + * mh-customize.el (mh-forward-hook): Define new hook. + * mh-comp.el (mh-forward): Use it. + +2003-11-07 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-utils.el (mh-show-toggle-mime-buttons) + (mh-show-display-with-external-viewer): New interactive functions + callable from the show buffer. + (mh-show-mime-map): Add bindings for "K t" and "K e". + (mh-show-msg): Propagate change to + mh-display-buttons-for-inline-parts-flag to the show buffer. + + * mh-mime.el (mh-display-with-external-viewer): New interactive + function to display MIME parts with external viewer (closes SF + #839318). + + * mh-e.el (mh-folder-mode): Make the variable + mh-display-buttons-for-inline-parts-flag buffer-local so that + display of MIME buttons can be toggled. + (mh-toggle-mime-buttons): New interactive function to toggle + display of MIME buttons. + (mh-mime-map): Modified to add bindings for "K t" and "K e". + +2003-11-04 Steve Youngs <sryoungs@bigpond.net.au> + + * Makefile (XEMACS_LOADDEFS_FILE): New. Used to generate mh-loaddefs.el + in XEmacs. + (XEMACS_LOADDEFS_COOKIE): Ditto. + (XEMACS_LOADDEFS_PKG_NAME): Ditto. + (xemacs): Add target to build mh-loaddefs.el in XEmacs + (clean-xemacs): Remove `mh-loaddefs.el*' + (loaddefs-xemacs): New rule to build mh-loaddefs.el in XEmacs. + +2003-11-02 Peter S Galbraith <psg@debian.org> + + * mh-init.el (mh-variant-set-variant): Reset `mh-x-mailer-string' + when we select an MH variant. + +2003-11-02 Jeffrey C Honig <jch@honig.net> + + * mh-loaddefs.el: Regenerated. + + * mh-funcs.el (mh-print-msg): Move to mh-print.el. + + * mh-e.el (mh-folder-mode-map): Add mh-print-msg ("l") back, it + will print a message that this usage is deprecated. + + * mh-print.el (require, mh-ps-print-msg, mh-ps-print-msg-file): + Require mh-funcs for mh-note-printed. PS print functions were not + setting the printed notation. Move mh-print-msg here for + consistency. Print message if mh-print-msg invoked via deprecated + key binding. + +2003-11-01 Peter S Galbraith <psg@debian.org> + + * Makefile: Add target to make `mh-startup.el', a file containg + usual entry commands into MH-E to be used for users installing + MH-E separately from Emacs. + + * README: Document the above for users. + +2003-10-29 Jeffrey C Honig <jch@honig.net> + + * mh-utils.el (mh-show-ps-print-map): Add "?" and "l" to + mh-show-ps-print-map. + + * mh-e.el (mh-ps-print-map, mh-help-messages): Add "?" and "l" to + mh-ps-print-map. Add "l" to help message. + +2003-10-27 Bill Wohler <wohler@newt.com> + + * Makefile (MH-E-SRC): Moved mh-xemacs.el to new variable + MH-E-XEMACS-SRC. + (MH-E-XEMACS-SRC): New variable to hold XEmacs source files. + (MH-E-XEMACS-OBJ): New variable to hold XEmacs object files. + (clean): Moved XEmacs-specific code to clean-xemacs. + (xemacs): Added clean-xemacs prerequisite. Moved down to + XEmacs section of file. + (clean-xemacs): New target to remove XEmacs-specific files. + (compile-xemacs): Added $(MH-E-XEMACS-SRC) prerequisite. + (dist): Added $(MH-E-XEMACS-SRC) to tarball. + +2003-10-27 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-index.el (mh-indexer-choices): Remove option for the non-free + glimpse indexer (closes SF #831276). + (mh-glimpse-binary, mh-glimpse-directory) + (mh-glimpse-execute-search, mh-glimpse-next-result): Functions + and variables to implement glimpse support are removed. + + * mh-customize.el (mh-index-program): Remove option for glimpse. + +2003-10-24 Satyaki Das <satyakid@stanford.edu> + + * mh-customize.el: Remove top-level test for toolbar enabled + XEmacs since it is not needed. + (mh-tool-bar-define): Add test for XEmacs toolbar in the functions + mh-toolbar-init, mh-tool-bar-letter-buttons-set and + mh-tool-bar-folder-buttons-set. This enables proper compilation + irrespective of whether the XEmacs was built with toolbar support + or not. + + * mh-comp.el (mh-letter-mode): Remove conditional since it is not + needed. + + * mh-e.el (mh-folder-mode): Same as above. + + * mh-utils.el (mh-show-mode): Same as above. + + * mh-xemacs.el (mh-xemacs-icon-map): Remove condition on toolbar + presence since we want the build to work if XEmacs without + toolbars is used during compilation. + +2003-10-23 Bill Wohler <wohler@newt.com> + + * mh-customize.el: The Great Reorganization. Sorted groups + alphabetically. Aligned variables in customization groups with + manual sections. Group docstrings changed to match manual chapter + titles. + +2003-10-22 Satyaki Das <satyakid@stanford.edu> + + * mh-speed.el (timer): Avoid compiler warning in XEmacs. + +2003-10-22 Steve Youngs <sryoungs@bigpond.net.au> + + * Makefile (XEMACS_OPTIONS): Add '-no-autoloads' to give a cleaner + build environment. + (AUTO_PRELOADS): Removed, in favour of 'AUTOLOAD_PACKAGE_NAME' and + 'AUTOLOAD_FILE'. + (AUTOLOAD_PACKAGE_NAME): New. + (AUTOLOAD_FILE): New. + (all): Don't set $EMACS_HOME if building with XEmacs. + (xemacs): Use 'compile-xemacs' instead of 'compile'. + (auto-autoloads.elc): Use new $AUTOLOAD_* vars and allow for + '-no-autoloads'. + (custom-load.elc): Allow for '-no-autoloads'. + (compile-xemacs): New. It allows for the '-no-autoloads' option + and byte-compiles all the source files with a single instance of + XEmacs. + + * mh-e.el (mh-folder-mode): Only load the toolbar in XEmacs if + toolbar support is available. + + * mh-comp.el (mh-letter-mode): Only load the toolbar in XEmacs if + toolbar support is available. + + * mh-customize.el: Require 'mh-xemacs' at toplevel when + 'mh-xemacs-flag' is non-nil. + Wrap all the toolbar code in a test that is true if using + GNU/Emacs or a toolbar-enabled XEmacs. + + * mh-print.el (mh-ps-spool-a-msg): Comment out + `clean-message-header-flag' because it isn't used anywhere. + + * mh-utils.el (mh-show-mode): Only load the toolbar in XEmacs if + toolbar support is available. + + * mh-xemacs.el: Autoload `regexp-opt', `customize-group', + `view-mode', `with-electric-help', `pp', `sort-numeric-fields', + `reverse-region', and `goto-address' at compile time. + (mh-xemacs-has-toolbar-flag): New. This is non-nil when XEmacs + has toolbar support. + (mh-xemacs-toolbar-*-icon): Use it. + +2003-10-21 Mark D. Baushke <mdb@gnu.org> + + * mh-identity.el (mh-identity-field-handler): Fields that begin + with ":" must have an mh-identity-handler defined or the user + gets an error. + +2003-10-17 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mh-identity-list): This change affects users! + The keyword "signature" becomes ":signature". The recently added + keyword "pgg-default-user-id" becomes ":pgg-default-user-id". + (mh-auto-fields-list): The keyword "Identity" becomes ":identity". + (mh-identity-handlers): Idem for signature and pgg-default-user-id. + + * mh-comp.el (mh-insert-auto-fields): Idem for Identity. + +2003-10-17 Peter S Galbraith <psg@debian.org> + + * mh-xemacs.el: Add eval-and-compile call to (load "toolbar" t t) to + make sure `toolbar-make-button-list' is defined. We can't use + require because Emacs doesn't have this library. + +2003-10-16 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-signature-file-name) + (mh-letter-insert-signature-hook): Merge docstring with manual. + + * mh-comp.el (mh-file-is-vcard-p): Checkdoc fix. + (mh-insert-signature): Merge docstring with manual. + + * mh-customize.el (mh-junk): Changed manual link in defgroup from + Customizing mh-e to Junk. + (mh-junk-function-alist): Moved SpamAssassin to first in list on + the hunch that it is the most popular and should be chosen if + other anti-spam programs exist. + (mh-junk-mail-folder): Since the variable can accept values other + than folder names, renamed to mh-junk-disposition to more + accurately reflect the content. Merge docstring with manual. + (mh-junk-program): Moved SpamAssassin to the top of the menu for + the same reason presented in mh-junk-function-alist. Also, fixed + case of spam programs to match official usage. Merge docstring + with manual. + + * mh-junk.el (mh-junk-blacklist): + s/mh-junk-mail-folder/mh-junk-disposition/. Merge docstring with + manual. + (mh-junk-whitelist): Merge docstring with manual. + (mh-bogofilter-blacklist): No longer suggest using automatic + classification so use -s instead of -Ns. + (mh-bogofilter-whitelist): No longer suggest using automatic + classification so use -n instead of -Sn. + (mh-spamassassin-blacklist, mh-spamassassin-whitelist): Merge + docstring with manual. Moved spamassassin functions to top of file + so functions appear in same order that they are presented in menu. + +2003-10-09 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mail-citation-hook): Moved from mh-comp.el and + made into a defcustom. + +2003-10-09 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-comp.el (mh-get-header-field): Add autoload cookie. + + * mh-utils.el (mh-show-ps-print-toggle-mime) + (mh-show-ps-print-toggle-color, mh-show-ps-print-toggle-faces) + (mh-show-ps-print-msg-file, mh-show-ps-print-msg) + (mh-show-ps-print-msg-show): New interactive functions callable + from the show buffer. + (mh-show-ps-print-map): New key map for printing. + + * mh-e.el (mh-folder-mode-map): Remove key binding for + mh-print-msg. + (mh-ps-print-map): Add new key map for printing. + + * Makefile (MH-E-SRC): Add mh-print.el. + +2003-10-07 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-x-image-url-fetch-image): In XEmacs, + make-temp-file is not present. So to avoid security problems, use + a temporary file in the user's home directory. This avoids issues + in creating files in a world-writable directory. + + * mh-mime.el (mh-signature-highlight): In Emacs, arrange for the + overlay to be freed when it is no longer needed. Also, implement + signature highlighting in XEmacs. + +2003-10-05 Satyaki Das <satyakid@stanford.edu> + + * mh-mime.el (mh-mime-display, mh-mm-inline-message): Respect the + value of `mm-verify-option' and `mm-decrypt-option'. + (mh-mime-display-security): Rearrange code a bit to avoid too many + new lines being inserted when message verification/decryption is + carried out while the message is being read. Also use the + point-m{in|ax}-marker functions to make the function easier to read. + (mh-mime-security-press-button): Extend the function so that the + user can verify/decrypt messages while reading them. + + * mh-gnus.el (mm-possibly-verify-or-decrypt): Added to avoid + compiler warning with old Gnus. + + * mh-utils.el (mh-x-image-url-sane-p): New function which checks + if the URL in X-Image-URL is something we can handle. + (mh-x-image-url-display): Don't display image if the URL looks + malformed. + +2003-10-04 Mark D Baushke <mdb@gnu.org> + + * mh-comp.el (mh-letter-menu): Simplify menu heading. + +2003-10-03 Mark D Baushke <mdb@gnu.org> + + * mh-mime.el (mh-mml-query-cryptographic-method): Avoid + revisionist history and still provide a good default. + + * mh-comp.el (mh-letter-menu): Remove the Disable Security + parenthetical comment. + + * mh-loaddefs.el: Regenerated. + + * mh-customize.el (mh-mml-method-default): What method should be + used in secure directives. + + * mh-mime.el (mh-secure-message): New function used to generate + the mml security tags. + (mh-mml-unsecure-message): New wrapper function around + mml-unsecure-messages. + (mh-mml-secure-message-sign-pgpmime): Remove function. + (mh-mml-secure-message-encrypt-pgpmime): Ditto. + (mh-mml-cryptographic-method-history): New variable. + (mh-mml-query-cryptographic-method): New function. + (mh-mml-secure-message-encrypt): Ditto. + (mh-mml-secure-message-signencrypt): Ditto. + (mh-mml-secure-message-sign): Ditto. + + * mh-comp.el (mh-letter-menu, mh-letter-mode-help-messages, + (mh-letter-mode-map): Update to use new functions. + +2003-09-26 Satyaki Das <satyakid@stanford.edu> + + * mh-seq.el (mh-interactive-range): The function has been + extended so that it now takes a default result to return if no + interactive prefix arg is given and no region is active. + + * mh-e.el (mh-add-sequence-notation): If transient-mark-mode is + on, then the active region is deactivated based on whether a user + sequence or a internal sequence is being notated. The change + removes this inconsistency. + (mh-catchup, mh-folder-map): A new interactive function to mark + messages as read has been added and bound to "F c" in the folder + mode. + + * mh-utils.el (mh-show-catchup, mh-show-folder-map): New + interactive function callable from show mode buffers has been + bound to "F c". + +2003-09-24 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-clean-message-header-flag) + (mh-invisible-header-fields-default, mh-invisible-header-fields): + Merge docstring with manual. + +2003-09-24 Mark D. Baushke <mdb@gnu.org> + + * mh-junk.el (mh-junk-blacklist): Junked messages should be put + into the mh-seen-list to avoid propagating the unseen sequence + into the spam folder. + + * mh-loaddefs.el: Regenerated. + + * mh-mime.el (mh-mml-secure-message-sign-pgpmime): Add an optional + dontsign argument to remove an existing secure message directive. + Update the docstring -- this fuction does not allow for + encrypt/sign, just sign directives. + + * mh-mime.el (mh-mml-secure-message-sign-pgpmime): Use + mml-insert-tag directly to provide a sender if + mh-identity-pgg-default-user-id is set. + (mh-mml-secure-message-encrypt-pgpmime): Use mml-insert-tag + directly to provide a sender if this message is to be both signed + and encrypted and mh-identity-pgg-default-user-id is set. + +2003-09-23 Bill Wohler <wohler@newt.com> + + * mh-alias.el (Commentary): Removed as it is now in the manual. + (mh-alias-system-aliases): Moved here from mh-customize.el. By + definition, "system" definitions are not user-visible, and user + filenames are in the the Aliasfile: profile component, so this + variable really shouldn't be a defcustom + (mh-alias-tstamp, mh-alias-filenames, mh-alias-reload) + (mh-alias-add-alias, mh-alias-grab-from-field) + (mh-alias-add-address-under-point, mh-alias-apropos): Merge + docstring with manual. + (mh-alias-reload-maybe): Minor comment update. + (mh-alias-insert-file): Merge docstring with manual. Removed + "[press TAB]" from prompt since users should know about completion + and space can be used as well. + (mh-alias-for-from-p): No longer returns a surprising result (t if + there was **not** an alias for the From field) if the From header + field is missing. This function now returns what you would expect + a function of this name to return. Renamed from + mh-alias-from-has-no-alias-p since negatives in the function name + make logic harder to follow. + (mh-alias-add-alias-to-file): Merge docstring with manual. + Improved verbiage of prompt. Aliases are now inserted "[b]efore" + or "[a]fter" the existing alias instead of "[i]nsert" or + "[a]ppend." Note how the new usage flows better. + + * mh-customize.el (mh-alias): Changed manual link in defgroup from + Customizing mh-e to Aliases. + (mh-alias-grab-from-field button): mh-alias-from-has-no-alias-p + renamed to mh-alias-for-from-p and no longer returns surprising + value if there isn't a From field. Therefore, enable button if + there is a From header field and mh-alias-for-from-p returns nil. + (mh-letter-complete-function) + (mh-alias-completion-ignore-case-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): Merge docstring with + manual. + (mh-alias-system-aliases): Moved to mh-alias.el. + + * mh-comp.el (mh-letter-complete-function-alist): Removed comment + about making this customizable since I didn't think it seemed + appropriate in the manual. + (mh-letter-complete): Merge docstring with manual. + +2003-09-23 Satyaki Das <satyakid@stanford.edu> + + * mh-speed.el (mh-speed-flists): When exiting emacs, don't ask if + the flists process should be killed. + + * mh-e.el (mh-folder-message-menu): Enable undo menu entry only + if something can be undone. + + * mh-customize.el (undo): Enable undo button only if something + can be undone. + +2003-09-22 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mh-identity-handlers): New defcustom. Alist of + Handler functions for mh-identity (downcased) fields. + (mh-identity-list): Add support for pgg-default-user-id. + + * mh-identity.el (mh-insert-identity): Modified to use + `mh-identity-handlers', adding hacking flexibility for those who + might need it. + (mh-identity-field-handler): New function. Return the handler for + a FIELD or nil if none set. The field name is downcased. + (mh-identity-handler-gpg-identity): New function; handler for pgg + pgp identities. It sets a buffer-local value for + `mh-pgg-default-user-id' which must be handled by mh-send-letter. + (mh-identity-pgg-default-user-id): New buffer-local variable to + hold the requested key ID. + (mh-identity-handler-signature): New function; handler t insert + and remove signature files. + (mh-identity-handler-default): New function; the default handler + to insert or remove generic field. + (mh-identity-handler-top): Insert a field at the top of the + header. + (mh-identity-handler-bottom): Insert a field at the bottom of the + header. + (mh-header-field-delete): Make more robust wrt the field having a + trailing colon or not. + (mh-identity-make-menu): Add a "Customize Identities" menu entry. + + * mh-loaddefs.el: Regenerated. + +2003-09-21 Peter S Galbraith <psg@debian.org> + + * mh-init.el (mh-variant-set): Bug fix for mh-variant long names + with version numbers. + + * mh-e.el (mh-scan-format): patch from Sergey Poznyakoff. + GNU mailutils now supports the %(decode) format + +2003-09-20 Satyaki Das <satyakid@stanford.edu> + + * mh-gnus.el (mh-mm-text-html-renderer): New function to query + which HTML renderer is being used by Gnus. + + * mh-mime.el (mh-signature-highlight): Renderers used to display + HTML parts garble the signature separator in various ways. The + function has been modified to take that into account. + (mh-mime-display-single, mh-mm-display-part): Pass the new + optional argument to `mh-signature-highlight'. + +2003-09-19 Mark D. Baushke <mdb@gnu.org> + + * mh-mime.el (mh-have-file-command, mh-file-mime-type): Made an + mh-autoload as they are used in mh-comp.el. + + * mh-loaddefs.el: Regenerated. + +2003-09-18 Peter S Galbraith <psg@debian.org> + + * mh-comp.el (mh-insert-fields): Make sure field has a colon. + +2003-09-18 Satyaki Das <satyakid@stanford.edu> + + * mh-seq.el (mh-toggle-tick): Don't hardcode the name of the tick + sequencence in the function. This would have caused improper + highlighting of the tick sequence if the user had changed its + name. + +2003-09-15 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-folder-message-menu): Fix a little bug which shows + up as a problem during compilation (closes SF #806577). + +2003-09-15 Mark D. Baushke <mdb@gnu.org> + + * mh-customize.el (mh-invisible-header-fields-internal): Added + a new field for GNU mailutils per Sergey Poznyakoff. + +2003-09-09 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (vcard): Unconditionally load vcard.el, if + available, so that vcards are always inlined. + +2003-09-09 Peter S Galbraith <psg@debian.org> + + * mh-mime.el (mh-file-mime-type-substitutions): Add entry to + convert text/plain .vcf files to text/x-vcard. + (mh-mime-content-types): Add text/x-vcard. + +2003-09-09 Bill Wohler <wohler@newt.com> + + * mh-comp.el (mh-rejected-letter-start): Added strings for qmail + and exim (addresses SF #404965). + +2003-09-09 Satyaki Das <satyakid@stanford.edu> + + * mh-gnus.el (mm-inline-text-vcard): Make vcard display work with + Gnus-5.9. The extra file vcard.el is still needed. + + * mh-mime.el (mh-signature-highlight): New function that + highlights message signatures. + (mh-mm-display-part, mh-mime-display-single): Highlight signatures + using `mh-signature-highlight' (closes SF #802722). More work is + needed for XEmacs. + (mh-mime-display): Highlight signature in non-MIME email too. + + * mh-customize.el (mh-show-signature-face): New face used to + display message signature. + +2003-09-08 Peter S Galbraith <psg@debian.org> + + * mh-e.el (mh-version): Do something sensible when + mh-variant-in-use is undefined. + * mh-junk.el (mh-spamassassin-blacklist) + (mh-spamassassin-whitelist): Change options to be compatoble with + old version of spamassassin (V2.20). + +2003-09-07 Mark D. Baushke <mdb@gnu.org> + + * mh-mime.el (mh-access-types): Per RFC 2049, the "afs" + access-type for message/external-body has been removed. + Update the comments to reference the current MIME RFCs + 2045, 2046 and 2049 rather than the obsolete RFC 1521. + +2003-09-05 Peter S Galbraith <psg@debian.org> + + * mh-e.el (mh-version): Bumped version number to 7.4.2+cvs. + +2003-09-04 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-picon-directory-list, mh-picon-directory): The + mh-picon-directory-list variable supersedes mh-picon-directory. + (mh-picon-existing-directory-list): New variable that contains + the list of picon directories that actually exist. + (mh-picon-set-directory-list): New function to update + mh-picon-existing-directory-list from mh-picon-directory-list. + (mh-picon-get-image): The function has been modified to search a + list of possible picon source directories. The regexp to extract + the username from the email address has been made smarter so that + it can recognize email addresses of the form user+random@foo.net + and extract "user" from there. + (mh-picon-file-contents): The file type recognition code has been + moved from mh-picon-get-image into this function. + (mh-picon-generate-path): The function has been generalized so + that searching multiple paths is now feasible. + + * mh-pick.el, mh-e.el: Checkdoc fixes. + +2003-09-02 Satyaki Das <satyakid@stanford.edu> + + * mh-identity.el (eval-when): It seems that the mh-comp-loaded + code isn't required any more. + +2003-08-30 Satyaki Das <satyakid@stanford.edu> + + * mh-init.el (mh-variant-set): Replace `error' with `message' so + that Emacs CVS will compile without errors if no MH variant is + present. + +2003-08-29 Satyaki Das <satyakid@stanford.edu> + + * mh-init.el (mh-variant-set): Add interactive spec to the + function. + + * mh-mime.el (mh-mhn-compose-external-type): Optional arguments + are prompted for only if prefix arg is given. + +2003-08-29 Mark D. Baushke <mdb@gnu.org> + + * mh-mime.el (mh-mhn-compose-external-type): Modified to be + interactive and prompts for many of the fields. Made an + mh-autoload. + (mh-access-types): New table derived from RFC2017, RFC1521 and + RFC1738, used in a completing-read in + mh-mhn-compose-external-type. + + * mh-loaddefs.el: Regenerated. + +2003-08-26 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-picon-image-types, mh-picon-get-image): Avoid + compiler warnings. + (mh-sub-folders-actual): Parsing of the output from folders has + been modified, so that it also works for MH (closes SF #792300). + + * mh-junk.el (mh-spamassassin-whitelist): Avoid calling + ietf-drums-parse-address if it isn't present. + (mh-spamassassin-identify-spammers): Avoid use of puthash so that + Emacs20 doesn't complain. + + * mh-e.el (mh-colors-available-p): Wrap call to + display-color-cells in a mh-funcall-if-exists to avoid compiler + warning in Emacs20. + +2003-08-25 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-colors-available-flag, mh-folder-mode): New + variable to track if colors are available and it is set + appropriately in mh-folder-mode. + (mh-colors-available-p, mh-colors-in-use-p): Two functions to + check whether colors are available and if they are actually being + used. + (mh-add-sequence-notation): Just changing a scan line doesn't + make font-lock refontify the line in Emacs20. So explicitly + refontify the scan line in such a situation. + (mh-internal-seq): If colors aren't being used then treat the + tick sequence like a normal user sequence. + + * mh-seq.el (mh-put-msg-in-seq): Do font-lock highlighting after + the messages have been added to the sequence. + (mh-toggle-tick): Modified so that highlighting of the ticked + messages will be properly done. If font-lock isn't being used or + if colors aren't supported by the Emacs where MH-E is running, + then the `%' character is used to annotate ticked messages. + + * mh-utils.el (mh-picon-image-types): Since Emacs20 doesn't have + image-type-available-p, wrap calls to that function in + ignore-errors. + (mh-add-msgs-to-seq): Do the font-lock highlighting after the + messages have been added. + +2003-08-24 Bill Wohler <wohler@newt.com> + + * Makefile (MH-E-SRC): Replaced mh-xemacs-compat.el and + mh-xemacs-icons.el with mh-xemacs.el. + + * mh-e.el: Don't require mh-xemacs-compat which no longer exists. + The XEmacs stuff gets required by mh-customize.el which is + required by mh-utils.el which is required by mh-e.el. This all + happens before mh-xemacs-compat was required, so all should be + well. + + * mh-unit.el (mh-unit-files): Replaced mh-xemacs-compat.el and + mh-xemacs-icons.el with mh-xemacs.el. + + * mh-xemacs.el: New file from concatenation of mh-xemacs-compat.el + and mh-xemacs-icons.el which were removed since their names + exceeded DOS 8+3 limits. + + * mh-customize.el (mh-compose-skipped-header-fields): Use + uppercase for field names. + +2003-08-21 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-sequences): Introduced new customization + group for sequences. + (mh-refile-preserves-sequences-flag, mh-tick-seq) + (mh-update-sequences-after-mh-show-flag): Moved option from + mh-folder to mh-sequences group. Synced docstring with manual. + (mh-index-ticked-messages-folders): Since mh-tick-seq is + customizable, use it instead of tick in the docstring. + + * mh-index.el (mh-index-ticked-messages): Since mh-tick-seq is + customizable, use it instead of tick in the docstring. + + * mh-seq.el (mh-msg-is-in-seq): Can now specify an alternate + message number with a prefix argument. + (mh-narrow-to-tick): Since mh-tick-seq is customizable, use it + instead of tick in the docstring. Also, use mh-tick-seq instead of + tick in warning message. + +2003-08-20 Peter S Galbraith <psg@debian.org> + + * mh-customize.el: setq mh-variant to 'none when byte-compiling, + since we don't care what MH variant (if any) is on the system at + that point. + + * mh-init.el (mh-variant-set): Don't probe for MH variant when + mh-variant is set to'none (during byte-compilation). + +2003-08-19 Peter S Galbraith <psg@debian.org> + + * mh-pick.el (mh-pick-single-dash): New defconst. Search + components that are supported by single-dash option in + pick. + (mh-pick-regexp-builder): Use `mh-pick-single-dash' and adapt + patch from Sergey Poznyakoff. + + * mh-comp.el (mh-reply): mu-mh supports `repl -group', thanks to + Sergey Poznyakof. + + * mh-init.el: checkdoc fixes. + +2003-08-19 Bill Wohler <wohler@newt.com> + + * mh-seq.el: (mh-edit-pick-expr): Renamed from mh-read-pick-regexp + since the new name is more indicative of what the function does. + Prompt now says "Pick expression" instead of "Pick regexp". + (mh-narrow-to-subject): Rewrote function to behave like other + similar functions. + (mh-narrow-to-header-field, mh-narrow-to-range) + (mh-narrow-to-tick): s/regexp/pick-expr/. + (mh-widen, mh-narrow-to-from, mh-narrow-to-cc, mh-narrow-to-to): + Synced docstrings with manual + 2003-08-19 Bill Wohler <wohler@newt.com> * Released MH-E version 7.4.2. @@ -131,6 +1367,848 @@ (patches from 1.307 and 1.309 and branched for 7.4.2, closes SF #791021). +2003-08-18 Bill Wohler <wohler@newt.com> + + * mh-index.el (mh-index-sequenced-messages) + (mh-index-new-messages, mh-index-ticked-messages): Updated + docstrings from manual (closes SF #718833). + + * mh-customize.el (mh-variant): Checkdoc fix. + (mh-index-new-messages-folders): Don't mention defvar in + docstring, use `+inbox' instead. + (mh-index-ticked-messages-folders): Don't mention defvar in + docstring, use `tick' instead. + + * mh-comp.el (mh-repl-group-formfile): Checkdoc fix. + +2003-08-18 Peter S Galbraith <psg@debian.org> + + * mh-init.el (mh-variant-set, mh-sys-path, mh-variant-info): Add + support for GNU mailutils. + (mh-variant-mu-mh-info): New function to detect mu-mh and return + info about it for `mh-variants'. + + * mh-e.el (mh-regenerate-headers): mu-mh has different error + message for a invalid mesage list. + +2003-08-18 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mh-e): New defgroup. Sort of an alias for the + 'mh group that a user might be more likely to find. + +2003-08-18 Bill Wohler <wohler@newt.com> + + * mh-comp.el (mh-insert-auto-fields-done-local): Docstring tweak. + (mh-compose-and-send-mail): Do not call mh-insert-auto-fields. + This should be done only once in mh-send-letter. + +2003-08-18 Peter S Galbraith <psg@debian.org> + + * mh-comp.el (mh-letter-mode): Call `mh-find-path unconditionally, + like elsewehere in MH-E. + + * mh-utils.el (mh-find-path): Run setup code only if + `mh-find-path-run' is nil such that this is only done once. + Also remove the `setq' for `read-mail-command' and `mail-user-agent'. + +2003-08-18 Peter S Galbraith <psg@debian.org> + + * mh-e.el: require 'mh-utils first + + * mh-customize.el (mh-variant): defcustom moved here. + + * mh-init.el (mh-variants): Made an mh-autoload. + +2003-08-18 Peter S Galbraith <psg@debian.org> + + * Makefile (MH-E-SRC): Added mh-init.el to MH-E-SRC. + + * mh-utils.el (mh-find-progs): Deleted. Make obsolete by mh-init.el. + (mh-find-path): Call `mh-variants' instead of now obsolete + `mh-find-progs'. + (mh-path-search): Deleted. Was only used by `mh-find-progs'. + + * mh-e.el: require mh-init.el. + (mh-version): Use simpler `mh-variant-in-use'. + (mh-scan-format): Use (mh-variant-p 'nmh) instead of mh-nmh-flag. + + * mh-comp.el (mh-insert-x-mailer): Use simpler `mh-variant-in-use'. + + * mh-utils.el (mh-progs, mh-lib, mh-lib-progs) + (mh-flists-present-flag): Moved to mh-init.el. + (mh-nmh-flag): Deleted. Use (mh-variant-p 'nmh) instead. + + * mh-comp.el (mh-repl-group-formfile, mh-forward, mh-reply) + (mh-send-letter): Use (mh-variant-p 'nmh) instead of mh-nmh-flag. + + * mh-mime.el (mh-edit-mhn, mh-mime-save-parts): Use (mh-variant-p + 'nmh) instead of mh-nmh-flag. + +2003-08-16 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-folder-selection): New group to hold + variables described in Folder Selection section in manual. + (mh-default-folder-list, mh-default-folder-must-exist-flag, + mh-default-folder-prefix): Moved to mh-folder-selection group. + Updated docstrings per manual update. + (mh-default-folder-for-message-function): New defcustom. Was a + defvar in mh-utils.el. Updated docstring per manual update. + + * mh-utils.el (mh-default-folder-for-message-function): Moved to + mh-customize.el. + + * mh-e.el (mh-folder-from-address, mh-prompt-for-refile-folder): + Updated docstrings per manual update. + + * mh-unit.el (mh-unit-files): Added mh-init.el. + +2003-08-16 Peter S Galbraith <psg@debian.org> + + * mh-init.el: New file. Code to initialize the MH-E back-end. + Highlights: + (mh-variant): New defcustom. Users may customize `mh-variant' to + switch between available variants. + (mh-variants): Available MH variants are described in this variable. + (mh-variant-in-use, mh-variant-p): Developers may check which + variant is currently in use with the variable `mh-variant-in-use' + or the function `mh-variant-p'. + +2003-08-15 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-auto-fields-list): The manual uses Fcc + instead of fcc, so I've changed the user-visible text + accordingly. I've left the const alone for backwards + compatibility. + +2003-08-14 Bill Wohler <wohler@newt.com> + + * mh-identity.el (mh-insert-identity): Changed signature deletion + test to test for both markers, rather than testing to see if the + start marker is bound. Since the start marker is defined in this + file, it should always be bound. Suggestion by Satyaki. + + * mh-comp.el (mh-send-letter): Go to the top of the draft so that + the user can see which header fields have been inserted. I think + this is more important than leaving point alone or going to the + end to see the signature since Mail-Followup-To or Bcc or cc could + have some deleterious effects. + + * mh-customize.el (mh-auto-fields-prompt-flag): New variable. + Non-nil means to prompt before sending if fields inserted. + + * mh-comp.el (mh-insert-auto-fields): Now return t if fields + inserted; otherwise nil. + (mh-send-letter): Deleted obsolete documentation about adding + X-Mailer and X-Face. Prompt before sending if auto fields added + and mh-auto-fields-prompt-flag is t. + + * mh-customize.el (mh-identity-list): Allow signature to come from + mh-signature-file-name. In this case, the "signature" value is set + to nil. This might not be the best implementation. Suggestions + welcome. + + * mh-identity.el (mh-insert-identity): Now that the signature can + be a nil value, moved test higher up in cond so that the test for + a nil value would not be executed first prevening signature + handling. Handle nil signature value by calling + mh-insert-signature with no arguments which means to use + mh-signature-file-name. + + * mh-comp.el (mh-insert-signature): Changed text of message if no + signature inserted. + + * mh-customize.el (mh-identity-list): Changed "Signature" constant + back to "signature" so it *won't* be backwards-incompatible any + more. I discovered one could use the :tag keyword to get headline + captalization in the menu. + + * mh-identity.el (mh-insert-identity): Ditto. + + * mh-identity.el (mh-identity-make-menu): Always build menu. + Always create Insert Auto Fields menu item. Just don't enable it + if mh-auto-fields-list is nil. Enable radio buttons always. Make + None a radio button choice with the other identities. + + * mh-comp.el (mh-letter-menu): Removed cond on fboundp + 'easy-menu-define. We don't do this elsewhere. + +2003-08-13 Bill Wohler <wohler@newt.com> + + * mh-identity.el (mh-identity-make-menu, mh-insert-identity): Use + headline capitalization in menu items. Even the internal names are + exposed in the customize interface, so they need to be uppercase + too. + (mh-insert-identity): Rather than goto-char to + mh-identity-signature-start before deleting, simply pass it to + delete-region. When setting markers, use point-min-marker and + point-max-marker instead of moving point. Set marker type of + mh-identity-signature-start to t to fix a bug where changing + identity deleted user's text. + + * mh-customize.el (mh-identity-list, mh-auto-fields-list): + Reworked docstring. Use headline capitalization. Commented out + implementation details for later deletion or resurrection upon + popular demand. N.B. If your mh-identity-list contains "signature" + then you will need to either edit your .emacs file manually, or + delete your existing "signature" which will become a regular field + with this change and create a new signature. I figured I could get + away with this since 8.0 is a major release, and coinciding with + the manual update will be a MAJOR release. I apologize profusely + that I didn't catch this before it was released. + (mh-identity-default): Use headline capitalization in example. + +2003-08-12 Jeffrey C Honig <jch@honig.net> + + * mh-customize.el (mh-alias-reloaded-hook): Define + `mh-alias-reloaded-hook'. + + * mh-alias.el (mh-alias-reload): Run `mh-alias-reloaded-hook' + after reloading the aliases. + +2003-08-12 Mark D. Baushke <mdb@gnu.org> + + * mh-comp.el (mh-insert-signature): Use functionp to avoid + the possibility of doing a funcall on a void function. + +2003-08-12 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-identity): Point group manual link to new + Identities section. + (mh-signature-separator-flag): New variable which can be used to + suppress the output of the signature separator. + + * mh-comp.el (mh-insert-signature): Use + mh-signature-separator-flag. + + * mh-identity.el (mh-insert-identity): If the identity's signature + file didn't exist, an fboundp error was thrown. This was fixed by + removing signature tests that were redundant and out of date with + the tests in mh-insert-signature. Removed second signature + condition as it is now handled in the first signature condition. + +2003-08-12 Peter S Galbraith <psg@debian.org> + + * mh-identity.el (mh-insert-identity): Don't insert new lines on + signatures anymore. + + * mh-comp.el (mh-insert-signature): Make sure signature file is + readable before trying to insert it. + +2003-08-11 Bill Wohler <wohler@newt.com> + + * mh-comp.el (mh-insert-signature): Unconditionally insert a + newline so that signatures are inserted consistently, and so that + there isn't any text after the cursor so that the user can start + typing his message immediately. Use new variable and function + mh-signature-separator and mh-signature-separator-p. + + * mh-customize.el (mh-delete-yanked-msg-window-flag): Checkdoc + fix. + (mh-signature-file-name): Updated docstring now that this variable + can be a function. Added cross-references to + mh-signature-separator, mh-signature-separator-regexp, and + mh-signature-separator-p which might be used in such functions. + + * mh-identity.el (mh-insert-identity): Don't include signature if + signature separator already present. Useful when running + mh-edit-again. + + * mh-mime.el (mh-inline-vcard-p): Use mh-signature-separator-p. + + * mh-utils.el (mh-signature-separator-regexp): New variable + containing "^-- $" which should be used when looking for the + signature separator. + (mh-signature-separator): New variable containing "-- \n" which + should be used when inserting the signature separator. + (mh-signature-separator-p): New function that returns non-nil if + mh-signature-separator-regexp is found in the buffer. + +2003-08-09 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-x-image-scaling-function): Variable that + contains function used to scale images. Possible choices are + mh-x-image-scale-with-convert and mh-x-image-scale-with-pnm. + (mh-convert-executable): Removed. + (mh-x-image-scale-with-pnm, mh-x-image-scale-with-convert): New + functions that scale images using pnm tools or ImageMagick. + (mh-x-image-scale-and-display, mh-x-image-url-display): Use + mh-x-image-scaling-function instead of mh-convert-executable. + +2003-08-08 Peter S Galbraith <psg@debian.org> + + * mh-comp.el (mh-insert-signature): Bug fix. Handle case of nil + `mh-signature-file-name' and hooks correctly. + + * mh-identity.el (mh-insert-identity): Refactor to use + mh-insert-signature + + * mh-comp.el (mh-signature-separator-p): Removed. + + * mh-comp.el (mh-insert-signature): Merge MIME awareness from + mh-insert-identity into this command. Allow + `mh-signature-file-name' to be a function to call. See if "-- " + needs to be inserted only after hooks have run. + +2003-08-07 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-compose-skipped-header-fields): Added + X-Image-URL. + (mh-autoload): Removed cookies. They aren't necessary in + mh-e.el, mh-utils.el, or mh-customize.el. + + * mh-e.el (mh-autoload): Removed cookies. They aren't necessary in + mh-e.el, mh-utils.el, or mh-customize.el. + + * mh-identity.el (mh-insert-identity): Made regexp for signature + separator more explicit. Hmmm, maybe we should create + mh-signature-separator-regexp... + + * mh-index.el (mh-replace-string): Moved to mh-utils.el. + + * mh-utils.el (mh-replace-string): Moved here from mh-index.el. + (mh-autoload): Removed cookies. They aren't necessary in mh-e.el, + mh-utils.el, or mh-customize.el. + + * mh-comp.el (mh-insert-signature): Added file argument to insert + a file other than mh-signature-file-name. Insert signature + separator, unless file already contains one. + +2003-08-06 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-folder-size, mh-folder-size-folder) + (mh-folder-size-flist): If flist is not present use folder to + find the number of messages in the folder. Also the .mh_sequences + file is read to find the number of unseen messages. + + * mh-utils.el (mh-flists-present-flag, mh-find-progs): Introduce + a new variable to test for the presence of the flists program and + set it in mh-find-progs. + +2003-08-06 Peter S Galbraith <psg@debian.org> + + * mh-customize.el: Change the order of `mh-identity-list' and + `mh-auto-fields-list' and remove byte-compilation defvar for + `mh-identity-list'. This fixes a customization bug for + `mh-identity-list', where it wasn't set correctly. + + * mh-identity.el (mh-identity-make-menu): mh-auto-fields-list may + not be bound yet when initially loaded. + +2003-08-06 Bill Wohler <wohler@newt.com> + + * mh-alias.el (mh-alias-add-address-under-point): Removed trailing + period from messages. The conventions say that errors should not + end with a period and that "Foo...done" messages should not end in + a period, but they aren't explicit about messages in general. + Given what the conventions *do* say, and because most of our + messages don't end with a period, let's just say that messages in + general don't end in a period, just like error messages. + + * mh-comp.el (mh-extract-rejected-mail, mh-letter-mode-message): + Ditto. + + * mh-e.el (mh-refile-a-msg): Ditto. + + * mh-funcs.el (mh-undo-folder): Ditto. + + * mh-mime.el (mh-mime-save-parts): Ditto. + + * mh-seq.el (mh-subject-to-sequence-unthreaded) + (mh-narrow-to-subject, mh-delete-subject): Ditto. + + * mh-index.el (mh-index-sequenced-messages) + (mh-index-new-messages, mh-index-ticked-messages): Discovered that + in general we should only use question marks in yes-or-no-p or + y-or-n-p prompts, but not in other prompts that use + completing-read and offer defaults. In these cases, use colons + instead (closes SF #730470). + + * mh-mime.el (mh-mime-save-parts): Ditto. + + * mh-utils.el (mh-prompt-for-folder): Ditto. + + * mh-alias.el (mh-alias-apropos): Multiple messages are usually + shown one at a time rather than appended. Send output to + mh-aliases-buffer instead of *Help*. + (mh-alias-local-users): Checkdoc fix. + + * mh-funcs.el (mh-undo-folder): Removed commented-out code since + its deadline had expired. + + * mh-utils.el (mh-aliases-buffer): New buffer name, used in + mh-aliases.el. + +2003-08-06 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-x-image-url-cache-canonicalize): Make this + function work for XEmacs too. + (mh-collect-folder-names): Use folders instead of flists. One + advantage is that folders is available on MH while flists is not. + Another is that if an explicit -sequence argument isn't given and + Unseen-Sequence profile is not present then flists croaks while + folders doesn't. + (mh-collect-folder-names-filter): Don't consider folder names that + start with a `.' character. This is needed since the folders + command doesn't filter them out like flists does. + + * mh-index.el (mh-replace-string): Add autoload for it. + +2003-08-05 Satyaki Das <satyakid@stanford.edu> + + * mh-mime.el (mh-compose-forward, mh-mhn-compose-forw) + (mh-mml-forward-message): The variable mh-sent-from-msg can be a + list. So check that the value is really a number before using it + like one. + + * mh-comp.el (mh-insert-letter): Same as above. + + * mh-utils.el (mh-picon-get-image): Make the code that finds the + address of the sender more robust. + (mh-face-display-function): Make it work with XEmacs. + (mh-picon-image-types): A new variable that stores what image + types can be used. + +2003-08-05 Satyaki Das <satyakid@stanford.edu> + + * mh-customize.el (mh-tool-bar-define): Make the save button such + that is activated only if the buffer needs to saved. + + * mh-utils.el (mh-face-display-function, mh-picon-get-image): Some + domains, for instance cs.cmu.edu, don't have xpm files. So we need + to search for all three files. The change does that. + (mh-picon-file-contents): A utility function to return the + contents of a file as a string. + (mh-picon-get-image): Write it as a loop to make it simpler. + (mh-x-image-set-download-state): Make the link simpler. + +2003-08-04 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-x-image-url-display): Don't bother to try to + download image if we don't have the necessary tools to display + it. + (mh-face-display-function): Add preliminary support for "domain" + picons. + (mh-picon-get-image, mh-picon-generate-path): Functions to find + best match for domain in the From header field. + + * mh-e.el (mh-previous-unread-msg): If some of the messages in the + unseen sequence are not present in the folder buffer then calling + this function gets stuck and can't skip over them. The change + fixes this. + (mh-next-unread-msg): Same as above. + +2003-08-04 Bill Wohler <wohler@newt.com> + + * mh-utils.el (mh-show-mode): Added cross reference to + mh-folder-mode in docstring (closes SF #728638). Added + \\{mh-show-mode-map} to show keymap. + + * mh-e.el (mh-folder-mode): Added information about ranges to + docstring (closes SF #728638). + + * mh-speed.el (mh-speed-refresh): New function that calls + mh-speed-flists and mh-invalidate-map. + (mh-folder-speedbar-key-map): Replaced keybindings for + mh-speed-invalidate-map and mh-speed-flists with a single binding + for mh-speed-refresh. + (mh-folder-speedbar-menu-items): Replaced menu items for Run + Flists and Invalidate Cached Folders with the single menu item + Refresh Speedbar in order to simplify the UI. + + * mh-customize.el (mh-fetch-x-image-url): Added DOS as another + reason not to set this to t. + +2003-08-04 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-scan-folder): Handle ranges from user input properly. + +2003-08-03 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-find-msg-get-num): Removed. If threading isn't + present, the messages are sorted by index. So `mh-goto-msg' was + implemented as a binary search and this function was used in that + implementation. So this isn't needed any more. + (mh-msg-search-pat): Removed. Before the advent of message + threading, this function was used to generate a regexp used to + search for a particular message. It isn't used anymore. The + variable `mh-scan-msg-number-regexp' should be updated and used in + `mh-goto-msg' instead of hardcoding the regexp in the code. Then + we might be able to better support other scan line formats in the + future. + + * mh-seq.el (mh-map-to-seq-msgs, mh-notate-seq): Removed. These + functions were used to notate user sequences. But calling + `mh-goto-msg' inside of a loop is inefficient. So the sequence + notation code was rewritten thereby making these functions + redundant. + (mh-copy-line-to-point): Removed. This function was used in the + implementation the now removed function `mh-copy-seq-to-point'. + That function was problematic and was replaced by the less general + `mh-copy-seq-to-eob'. This makes `mh-copy-line-to-point' + redundant. + (mh-region-to-msg-list): Removed since this is a special case of + the more general `mh-range-to-msg-list'. + + * mh-loaddefs.el: Regenerated. + +2003-08-03 Jeffrey C Honig <jch@honig.net> + + * mh-customize.el (mh-invisible-header-fields-default): Added + several new fields to hide. Sorted the list with sort-lines. + +2003-08-03 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mh-invisible-headers): Variable renamed to + `mh-invisible-header-fields-compiled'. + (mh-invisible-headers): Implement above change. + + * mh-utils.el (mh-display-msg): Idem. + + * mh-mime.el (mh-mm-inline-message): Idem. + + * mh-comp.el (mh-insert-letter): Idem. + +2003-08-03 Bill Wohler <wohler@newt.com> + + * mh-speed.el (mh-folder-speedbar-menu-items): Added separator + between standard and MH-E menu items. Use headline capitalization + in menu items. + + * mh-utils.el (mh-temp-fetch-buffer): New constant to hold + buffer name for wget output. + (mh-x-image-url-fetch-image): Use mh-temp-fetch-buffer instead + of hard-coded buffer name. Use make-temp-file to avoid race + conditions and subsequent security issues raised in make-temp-name + docstring. + +2003-08-03 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-wget-executable, mh-wget-choice, mh-wget-option) + (mh-x-image-url-fetch-image): Support the use of `curl' and + `fetch' as alternatives to `wget'. + (mh-wget-choice): Change order of search. + (mh-x-image-url-fetch-image): Rename buffer. + +2003-08-03 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-x-image-set-download-state) + (mh-x-image-get-download-state): Specially named symbolic links + are used to keep track of whether a X-Image-URL header field needs + to downloaded the next time it is seen. These functions get and + set the symlinks appropriately. + (mh-x-image-url-fetch-image): Simplified since the query has been + moved to `mh-x-image-url-display'. Also if wget isn't present then + try again next time since the user might install wget before + trying once more. + (mh-x-image-scale-and-display): Handle absence of the `convert' + program better. If it isn't present then we will try to display + the image the next time it is encountered. Also use the -geometry + option to convert since the -resize option isn't present in older + versions. + (mh-x-image-url-display): Move all the code that decides whether + an X-Image-URL header field will be fetched in this function. Also + remember the user's decision so that if the image couldn't be + fetched the first time, we will try to fetch it later on without + asking again. + +2003-08-02 Peter S Galbraith <psg@debian.org> + + * mh-alias.el (mh-alias-local-users): Exclude all aliases already + in mh-alias-alist from `ali' (closes SF #772595). + +2003-08-01 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-x-image-display, mh-x-image-url-display): Avoid + a race. The X-Image-URL is displayed asynchronously. Suppose a + message with a image is shown with `mh-show'. If a different + message is displayed before the image can be fetched, then the new + message will have the image displayed. With this change the race + is less likely to happen. + +2003-08-01 Peter S Galbraith <psg@debian.org> + + * mh-inc.el (mh-inc-spool-map): Fix what `mh-inc-spool-map-help' + must look like as a fake `mh-help-messages' in order to work + correctly in mh-help. + +2003-07-31 Bill Wohler <wohler@newt.com> + + * mh-inc.el (mh-inc-spool-map): Use mh-help instead of + mh-ephem-message in order to display help in its own buffer + instead of minibuffer. + + * mh-utils.el (mh-help-buffer): New variable to hold the name of + the MH-E help buffer name. + + * mh-funcs.el (mh-help, mh-prefix-help): Use with-electric-help to + display help messages. I observed a friend with a vision + disability and the 5 seconds the help appeared on the screen was + not long enough for him to lock on it. I've therefore changed the + help function to display the help in its own buffer called *MH-E + Help* (closes SF #493740 and SF #656631). + + * mh-customize.el (mh-fetch-x-image-url): Changed default from nil + to 'ask. Updated docstring from manual. + (mh-invisible-header-fields-internal): Added X-Image-URL. + (mh-show-use-xface-flag): Updated docstring from manual. + (mh-x-face-file): Ditto. + + * mh-mime.el (mh-mhn-compose-external-type): Don't insert the + directory parameter if it's nil. The mhbuild man page indicates + that this parameter is optional, so this should be fine. + + * mh-comp.el (mh-letter-mode-map): Added keybindings for + mh-mhn-compose-anon-ftp and + mh-mhn-compose-external-compressed-tar. + (mh-letter-menu): Uncommented menu items for same. + +2003-07-30 Satyaki Das <satyakid@stanford.edu> + + * mh-loaddefs.el: Regenerated. + + * mh-pick.el (mh-do-pick-search): Removed since the function + `mh-pick-do-search' performs the same action as this function. + + * mh-index.el (mh-index-update-unseen): Removed since the + generalized sequence synchronization code that keeps sequences in + index folders in sync with the sequences in the source folders + makes this function redundant. + + * mh-e.el (mh-folder-unseen-seq-name, mh-folder-unseen-seq-list): + Removed. These two functions were used in the unseen sequence + highlighting before the sequence highlighting code was + generalized. In any event calls to the function + `mh-folder-unseen-seq-name' can be replaced by the variable + `mh-unseen-seq' and calls to `mh-folder-unseen-seq-list' can be + replaced with (cdr (assoc mh-unseen-seq mh-seq-list)). + (mh-unmark-all-headers): Removed since this function has been + superseded by mh-remove-all-notation. + (mh-map-over-seqs): Removed since we now have the generalized + iteration over message ranges (the `mh-iterate-on-range' macro) + that can be used instead. + (mh-notate-if-in-one-seq): Removed. This function was used for + changing the `%' notation for user sequences. It can't be used for + that purpose any more, since we have a different scheme now. + + * mh-unit.el (mh-unit-tests): Removed since it isn't needed any + more. + (mh-unit): Run all function that start with the string + "mh-unit-test-". + +2003-07-30 Bill Wohler <wohler@newt.com> + + * mh-customize.el (mh-invisible-header-fields): Checkdoc fix. + + * mh-utils.el (mh-x-image-url-cache-canonicalize): Shortened using + example in files.el:make-backup-file-name-1. + (mh-face-display-function): Added X-Image-URL to docstring. + + * mh-unit.el (mh-unit-x-image-url-cache-canonicalize): New + function to test mh-x-image-url-cache-canonicalize since it lent + itself well to unit testing. Had to start somewhere! + (mh-unit-equal): New function that throws an error if RESULT + doesn't equal EXPECTED. + (mh-unit): Call mh-unit-x-image-url-cache-canonicalize. + +2003-07-29 Satyaki Das <satyakid@stanford.edu> + + * mh-unit.el (mh-unit-update-call-graph): Make the function work + better with dotted lists, that is lists of the form (a b c . d) + where `d' isn't nil. With this we are able to avoid marking some + functions as unused even though they are actually used in alists. + +2003-07-28 Peter S Galbraith <psg@debian.org> + + * mh-comp.el (mh-insert-letter): Remove `mh-visible-headers' + operation. + + * mh-mime.el (mh-mm-inline-message): Same. + + * mh-utils.el (mh-display-msg): Same. + (mh-clean-msg-header): Make a note of above change. + + * mh-customize.el (mh-invisible-header-fields-internal): Renamed + from prior `mh-invisible-header-fields-default'. + (mh-invisible-header-fields-default): Renamed from prior + `mh-invisible-header-fields-default-override'. + (mh-invisible-header-fields): Renamed from prior + `mh-invisible-header-fields-user'. + (mh-visible-headers): Removed! We use invisible fields only now. + (mh-visible-header-fields): Removed! + +2003-07-28 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mh-invisible-header-fields-default): Added 3 + new fields to hide. + +2003-07-28 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-show): Add an extra argument to the function so + that interactive use will always force redisplay of the message. + + * mh-mime.el (mh-mime-display, mh-mm-inline-message): Bind the + variables `mm-verify-option' and `mm-decrypt-option' so that + verification and decryption of mail can happen without any + additional tinkering. + +2003-07-25 Peter S Galbraith <psg@debian.org> + + * mh-customize.el (mh-invisible-header-fields-default): New defvar + holding default fields to hide. This replaces the old + `mh-invisible-header-fields' defcustom. + (mh-invisible-header-fields-user): New defcustom. Users add + fields to suppress that we didn't include in + `mh-invisible-header-fields-default'. This could be named simply + `mh-invisible-header-fields' and it wouldn't really break anything + for users who have customized it to a long list now redundant with + `mh-invisible-header-fields-default'. + (mh-invisible-header-fields-default-override): New defcustom. + Users check off the fields they want displyed from what we + included in `mh-invisible-header-fields-default'. + (mh-invisible-headers): Function adapted to new variables. + +2003-07-25 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-inc-folder): If the user is in a different folder + displaying a message and runs mh-inc-folder, then the folder + changes to +inbox but the show window continues to display the + message in the old folder. The change fixes this. + (mh-visit-folder): Make the handling of the show window similar to + that of mh-inc-folder. + +2003-07-24 Satyaki Das <satyakid@stanford.edu> + + * mh-e.el (mh-folder-message-menu, mh-folder-folder-menu): Use the + predicate mh-outstanding-commands-p instead of its exapansion. + Also use the same label in both menus. + (mh-outstanding-commands-p): Generalized so that it will work in + mh-show-mode buffers as well. + + * mh-customize.el (mh-tool-bar-define): Enable tool-bar button for + mh-execute-commands only if there are pending deletes or refiles. + +2003-07-19 Satyaki Das <satyakid@stanford.edu> + + * mh-utils.el (mh-show-msg): If a unseen message is first marked + for deletion/refiling and then displayed, the bold highlighting + does not go away. This change fixes that. + + * mh-seq.el (mh-msg-is-in-seq): Fix a bug in the function. If any + message was marked for refiling, then the function would have you + believe that every message in the folder is being refiled. + +2003-07-17 Bill Wohler <wohler@newt.com> + + * mh-e.el: Removed email address for Stephen Gildea's in Change + Log at his request (damn spammers). Removed other email addresses + while I was at it since the SourceForge URL should be sufficient + contact information. + + (mh-scan-format-*mh): Fixed typo in comment above these variables. + These variables are used if mh-scan-format-file is t, not nil. + Also mh-scan-format-file is no longer "above" (courtesy Stephen + Gildea). + +2003-07-17 Satyaki Das <satyakid@stanford.edu> + + * mh-mime.el (mh-mhn-quote-unescaped-sharp): New function that + quotes `#' characters in the first column that aren't part of a + MHN directive. + (mh-mhn-directive-present-p): Generalized to allow the function + to search for MHN directives in a part of the buffer. + (mh-edit-mhn): Quote unescaped `#' characters in the draft (closes + SF #762464). + +2003-07-16 Satyaki Das <satyakid@stanford.edu> + + * mh-alias.el (mh-alias-read-address-map): If + mh-alias-flash-on-comma is nil when mh-alias is loaded, then + setting mh-alias-flash-on-comma to t later on doesn't turn on + address completion display till Emacs is restarted. The change + fixes this. + +2003-07-15 Bill Wohler <wohler@newt.com> + + * mh-utils.el (mh-cmd-note): Cleaned up docstring (changed phrase + to sentences). Moved to Scan Line Formats section. + (mh-scan-msg-number-regexp) + (mh-scan-msg-overflow-regexp, mh-scan-msg-format-regexp) + (mh-scan-msg-format-string, mh-scan-msg-search-regexp): Cleaned up + docstrings (changed phrases to sentences). + (mh-note-seq): Cleaned up docstring (changed phrase to sentences). + Also, this variable is now a character and not a string. Moved to + Scan Line Formats section. + + * mh-funcs.el (mh-note-copied, mh-note-printed): Cleaned up + docstrings (changed phrases to sentences). Also, these variables + are now characters and not strings. + + * mh-e.el (mh-scan-format-mh, mh-scan-format-nmh): Filled. I was + hoping to quote the hint `t' but checkdoc wouldn't let me. + (mh-note-deleted, mh-note-refiled, mh-note-cur): Moved to Scan + Line Formats section. + (mh-scan-good-msg-regexp, mh-scan-deleted-msg-regexp) + (mh-scan-refiled-msg-regexp, mh-scan-valid-regexp) + (mh-scan-cur-msg-number-regexp, mh-scan-date-regexp) + (mh-scan-rcpt-regexp, mh-scan-body-regexp) + (mh-scan-subject-regexp, mh-scan-format-regexp): Cleaned + up docstrings (changed phrases to sentences). + (mh-scan-cur-msg-regexp): Marked this variable as obsolete; it + should be removed for 8.0. + + * mh-comp.el (mh-note-repl, mh-note-forw, mh-note-dist): Cleaned + up docstrings (changed phrases to sentences). Also, these + variables are now characters and not strings. + +2003-07-15 Satyaki Das <satyakid@stanford.edu> + + * mh-index.el (mh-index-update-single-msg) + (mh-index-create-sequences): Handle the situation where there are + copies of the exact same message correctly. + +2003-07-15 Satyaki Das <satyakid@stanford.edu> + + * mh-seq.el (mh-thread-update-scan-line-map): Modified since + notation is already a character. + + * mh-utils.el (mh-note-seq): Convert from string to character. + (mh-notate): Modified since characters are used to notate instead + of strings of length one. + + * mh-comp.el (mh-note-repl, mh-note-forw, mh-note-dist): Convert + from string to characters. + + * mh-e.el (mh-note-deleted, mh-note-refiled, mh-note-cur): Same as + above (closes SF #770772). + (mh-unmark-all-headers): Modified since mh-note-* variables are + now characters. + (mh-remove-sequence-notation): The mh-notate function remembers + the previous notation. Before the change to the mh-note-* + variables, mh-notate would only remember the change if a string + was used to notate the message. Now mh-notate is always called + with a character notation. So the deletion has to take place + explicitly. + +2003-06-28 Bill Wohler <wohler@newt.com> + + * mh-mime.el (mh-mhn-directive-present-p): If shell comments are + present that have a space after the # but no content, then this + function would throw an error. This has been fixed (closes SF + #762458). + +2003-06-27 Satyaki Das <satyakid@stanford.edu> + + * mh-index.el (mh-index-search): Use the new and improved + mh-index-new-folder. + (mh-index-new-folder): Improved so that redoing the same search + will reuse the old index folder. + (mh-index-folder-search-regexp): New function which that extracts + out the search expression that produced the index folder. + +2003-06-24 Bill Wohler <wohler@newt.com> + + * mh-e.el (Version, mh-version): Set to 7.4.1+cvs. + 2003-06-25 Bill Wohler <wohler@newt.com> * Released MH-E version 7.4.1. diff --git a/lisp/mh-e/mh-acros.el b/lisp/mh-e/mh-acros.el new file mode 100644 index 00000000000..16383304503 --- /dev/null +++ b/lisp/mh-e/mh-acros.el @@ -0,0 +1,144 @@ +;;; mh-acros.el --- Macros used in MH-E + +;; Copyright (C) 2004 Free Software Foundation, Inc. + +;; Author: Satyaki Das <satyaki@theforce.stanford.edu> +;; Maintainer: Bill Wohler <wohler@newt.com> +;; Keywords: mail +;; See: mh-e.el + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This file contains macros that would normally be in mh-utils.el except that +;; their presence there would cause a dependency loop with mh-customize.el. +;; This file must always be included like this: +;; +;; (eval-when-compile (require 'mh-acros)) +;; +;; It is so named with a silent `m' so that it is compiled first. Otherwise, +;; "make recompile" in Emacs 21.4 fails. + +;;; Change Log: + +;;; Code: + +(require 'cl) + +;; The Emacs coding conventions require that the cl package not be required at +;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl +;; routines in their macro expansions. Use mh-require-cl to provide the cl +;; routines in the best way possible. +(defmacro mh-require-cl () + "Macro to load `cl' if needed. +Some versions of `cl' produce code for the expansion of +\(setf (gethash ...) ...) that uses functions in `cl' at run time. This macro +recognizes that and loads `cl' where appropriate." + (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash) + `(require 'cl) + `(eval-when-compile (require 'cl)))) + +;;; Macros to generate correct code for different emacs variants + +(defmacro mh-do-in-gnu-emacs (&rest body) + "Execute BODY if in GNU Emacs." + (unless (featurep 'xemacs) `(progn ,@body))) +(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun) + +(defmacro mh-do-in-xemacs (&rest body) + "Execute BODY if in GNU Emacs." + (when (featurep 'xemacs) `(progn ,@body))) +(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun) + +(defmacro mh-funcall-if-exists (function &rest args) + "Call FUNCTION with ARGS as parameters if it exists." + (if (fboundp function) + `(funcall ',function ,@args))) + +(defmacro mh-make-local-hook (hook) + "Make HOOK local if needed. +XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be +called." + (when (and (fboundp 'make-local-hook) + (not (get 'make-local-hook 'byte-obsolete-info))) + `(make-local-hook ,hook))) + +(defmacro mh-mark-active-p (check-transient-mark-mode-flag) + "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs. +In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if +variable `transient-mark-mode' is active." + (cond ((featurep 'xemacs) ;XEmacs + `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) + ((not check-transient-mark-mode-flag) ;GNU Emacs + `(and (boundp 'mark-active) mark-active)) + (t ;GNU Emacs + `(and (boundp 'transient-mark-mode) transient-mark-mode + (boundp 'mark-active) mark-active)))) + +(defmacro mh-defstruct (name-spec &rest fields) + "Replacement for `defstruct' from the `cl' package. +The `defstruct' in the `cl' library produces compiler warnings, and generates +code that uses functions present in `cl' at run-time. This is a partial +replacement, that avoids these issues. + +NAME-SPEC declares the name of the structure, while FIELDS describes the +various structure fields. Lookup `defstruct' for more details." + (let* ((struct-name (if (atom name-spec) name-spec (car name-spec))) + (conc-name (or (and (consp name-spec) + (cadr (assoc :conc-name (cdr name-spec)))) + (format "%s-" struct-name))) + (predicate (intern (format "%s-p" struct-name))) + (constructor (or (and (consp name-spec) + (cadr (assoc :constructor (cdr name-spec)))) + (intern (format "make-%s" struct-name)))) + (field-names (mapcar #'(lambda (x) (if (atom x) x (car x))) fields)) + (field-init-forms (mapcar #'(lambda (x) (and (consp x) (cadr x))) + fields)) + (struct (gensym "S")) + (x (gensym "X")) + (y (gensym "Y"))) + `(progn + (defun* ,constructor (&key ,@(mapcar* #'(lambda (x y) (list x y)) + field-names field-init-forms)) + (list (quote ,struct-name) ,@field-names)) + (defun ,predicate (arg) + (and (consp arg) (eq (car arg) (quote ,struct-name)))) + ,@(loop for x from 1 + for y in field-names + collect `(defmacro ,(intern (format "%s%s" conc-name y)) (z) + (list 'nth ,x z))) + (quote ,struct-name)))) + +(defadvice require (around mh-prefer-el activate) + "Modify `require' to load uncompiled MH-E files." + (or (featurep (ad-get-arg 0)) + (and (string-match "^mh-" (symbol-name (ad-get-arg 0))) + (load (format "%s.el" (ad-get-arg 0)) t t)) + ad-do-it)) + +(provide 'mh-acros) + +;;; Local Variables: +;;; no-byte-compile: t +;;; indent-tabs-mode: nil +;;; sentence-end-double-space: nil +;;; End: + +;; arch-tag: b383b49a-494f-4ed0-a30a-cb6d5d2da4ff +;;; mh-acros.el ends here diff --git a/lisp/mh-e/mh-alias.el b/lisp/mh-e/mh-alias.el index bd20b9118b0..1356e2c8b95 100644 --- a/lisp/mh-e/mh-alias.el +++ b/lisp/mh-e/mh-alias.el @@ -27,75 +27,12 @@ ;;; Commentary: -;; [To be deleted when documented in MH-E manual.] -;; -;; This module provides mail alias completion when entering addresses. -;; -;; Use the TAB key to complete aliases (and optionally local usernames) when -;; initially composing a message in the To: and Cc: minibuffer prompts. You -;; may enter multiple addressees separated with a comma (but do *not* add any -;; space after the comma). -;; -;; In the header of a message draft, use "M-TAB (mh-letter-complete)" to -;; complete aliases. This is useful when you want to add an addressee as an -;; afterthought when creating a message, or when adding an additional -;; addressee to a reply. -;; -;; By default, completion is case-insensitive. This can be changed by -;; customizing the variable `mh-alias-completion-ignore-case-flag'. This is -;; useful, for example, to differentiate between people aliases in lowercase -;; such as: -;; -;; p.galbraith: Peter Galbraith <GalbraithP@dfo-mpo.gc.ca> -;; -;; and lists in uppercase such as: -;; -;; MH-E: MH-E mailing list <mh-e-devel@lists.sourceforge.net> -;; -;; Note that this variable affects minibuffer completion only. If you have an -;; alias for P.Galbraith and type in p.galbraith at the prompt, it will still -;; be expanded in the letter buffer because MH is case-insensitive. -;; -;; When you press ", (mh-alias-minibuffer-confirm-address)" after an alias in -;; the minibuffer, the expansion for the previous mail alias appears briefly. -;; To inhibit this, customize the variable `mh-alias-flash-on-comma'. -;; -;; The addresses and aliases entered in the minibuffer are added to the -;; message draft. To expand the aliases before they are added to the draft, -;; customize the variable `mh-alias-expand-aliases-flag'. -;; -;; Completion is also performed on usernames extracted from the /etc/passwd -;; file. This can be a handy tool on a machine where you and co-workers -;; exchange messages, but should probably be disabled on a system with -;; thousands of users you don't know. This is done by customizing the -;; variable `mh-alias-local-users'. This variable also takes a string which -;; is executed to generate the password file. For example, you'd use "ypcat -;; passwd" for NIS. -;; -;; Aliases are loaded the first time you send mail and get the "To:" prompt -;; and whenever a source of aliases changes. Sources of system aliases are -;; defined in the customization variable `mh-alias-system-aliases' and -;; include: -;; -;; /etc/nmh/MailAliases -;; /usr/lib/mh/MailAliases -;; /etc/passwd -;; -;; Sources of personal aliases are read from the files listed in your MH -;; profile component Aliasfile. Multiple files are separated by white space -;; and are relative to your mail directory. -;; -;; Alias Insertions -;; ~~~~~~~~~~~~~~~~ -;; There are commands to insert new aliases into your alias file(s) (defined -;; by the `Aliasfile' component in the .mh_profile file or by the variable -;; `mh-alias-insert-file'). In particular, there is a tool-bar icon to grab -;; an alias from the From line of the current message. - ;;; Change Log: ;;; Code: +(eval-when-compile (require 'mh-acros)) +(mh-require-cl) (require 'mh-e) (load "cmr" t t) ; Non-fatal dependency for ; completing-read-multiple. @@ -116,15 +53,23 @@ (defvar mh-alias-tstamp nil "Time aliases were last loaded.") (defvar mh-alias-read-address-map nil) -(if mh-alias-read-address-map - () +(unless mh-alias-read-address-map (setq mh-alias-read-address-map (copy-keymap minibuffer-local-completion-map)) - (if mh-alias-flash-on-comma - (define-key mh-alias-read-address-map - "," 'mh-alias-minibuffer-confirm-address)) + (define-key mh-alias-read-address-map + "," 'mh-alias-minibuffer-confirm-address) (define-key mh-alias-read-address-map " " 'self-insert-command)) +(defvar mh-alias-system-aliases + '("/etc/nmh/MailAliases" "/etc/mh/MailAliases" + "/usr/lib/mh/MailAliases" "/usr/share/mailutils/mh/MailAliases" + "/etc/passwd") + "*A list of system files which are a source of aliases. +If these files are modified, they are automatically reread. This list need +include only system aliases and the passwd file, since personal alias files +listed in your `Aliasfile:' MH profile component are automatically included. +You can update the alias list manually using \\[mh-alias-reload].") + ;;; Alias Loading @@ -138,7 +83,7 @@ This is a wrapper around `assoc-string' or `assoc-ignore-case'. Avoid (defun mh-alias-tstamp (arg) "Check whether alias files have been modified. -Return t if any file listed in the MH profile component Aliasfile has been +Return t if any file listed in the Aliasfile MH profile component has been modified since the timestamp. If ARG is non-nil, set timestamp with the current time." (if arg @@ -157,7 +102,7 @@ If ARG is non-nil, set timestamp with the current time." (defun mh-alias-filenames (arg) "Return list of filenames that contain aliases. -The filenames come from the MH profile component Aliasfile and are expanded. +The filenames come from the Aliasfile profile component and are expanded. If ARG is non-nil, filenames listed in `mh-alias-system-aliases' are appended." (or mh-progs (mh-find-path)) (save-excursion @@ -201,7 +146,8 @@ non-nil." res)) (defun mh-alias-local-users () - "Return an alist of local users from /etc/passwd." + "Return an alist of local users from /etc/passwd. +Exclude all aliases already in `mh-alias-alist' from `ali'" (let (passwd-alist) (save-excursion (set-buffer (get-buffer-create mh-temp-buffer)) @@ -222,23 +168,33 @@ non-nil." (gecos-name (match-string 3)) (realname (mh-alias-gecos-name gecos-name username - mh-alias-passwd-gecos-comma-separator-flag))) - (setq passwd-alist - (cons - (list (if mh-alias-local-users-prefix - (concat mh-alias-local-users-prefix - (mh-alias-suggest-alias realname t)) - username) - (if (string-equal username realname) - (concat "<" username ">") - (concat realname " <" username ">"))) - passwd-alist)))))) + mh-alias-passwd-gecos-comma-separator-flag)) + (alias-name (if mh-alias-local-users-prefix + (concat mh-alias-local-users-prefix + (mh-alias-suggest-alias realname t)) + username)) + (alias-translation + (if (string-equal username realname) + (concat "<" username ">") + (concat realname " <" username ">")))) + (when (not (mh-assoc-ignore-case alias-name mh-alias-alist)) + (setq passwd-alist (cons (list alias-name alias-translation) + passwd-alist))))))) (forward-line 1))) passwd-alist)) ;;;###mh-autoload (defun mh-alias-reload () - "Load MH aliases into `mh-alias-alist'." + "Reload MH aliases. + +Since aliases are updated frequently, MH-E will reload aliases automatically +whenever an alias lookup occurs if an alias source (a file listed in your +`Aliasfile:' profile component and your password file if variable +`mh-alias-local-users' is non-nil) has changed. However, you can reload your +aliases manually by calling this command directly. + +The value of `mh-alias-reloaded-hook' is a list of functions to be called, +with no arguments, after the aliases have been loaded." (interactive) (save-excursion (message "Loading MH aliases...") @@ -269,13 +225,14 @@ non-nil." (if (not (mh-assoc-ignore-case (car user) mh-alias-alist)) (setq mh-alias-alist (append mh-alias-alist (list user)))) (setq local-users (cdr local-users))))) + (run-hooks 'mh-alias-reloaded-hook) (message "Loading MH aliases...done")) ;;;###mh-autoload (defun mh-alias-reload-maybe () "Load new MH aliases." - (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist, so create it. - (mh-alias-tstamp nil)) ; Out of date, so recreate it. + (if (or (eq mh-alias-alist 'not-read) ; Doesn't exist? + (mh-alias-tstamp nil)) ; Out of date? (mh-alias-reload))) @@ -461,21 +418,21 @@ is converted to lower case." found))) (defun mh-alias-insert-file (&optional alias) - "Return the alias file to write a new entry for ALIAS in. -Use variable `mh-alias-insert-file' if non-nil, else use AliasFile component -value. -If ALIAS is specified and it already exists, try to return the file that -contains it." + "Return filename which should be used to add ALIAS. +The value of the option `mh-alias-insert-file' is used if non-nil\; otherwise +the value of the `Aliasfile:' profile component is used. +If the alias already exists, try to return the name of the file that contains +it." (cond ((and mh-alias-insert-file (listp mh-alias-insert-file)) (if (not (elt mh-alias-insert-file 1)) ; Only one entry, use it (car mh-alias-insert-file) (if (or (not alias) (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist - (completing-read "Alias file [press Tab]: " + (completing-read "Alias file: " (mapcar 'list mh-alias-insert-file) nil t) (or (mh-alias-which-file-has-alias alias mh-alias-insert-file) - (completing-read "Alias file [press Tab]: " + (completing-read "Alias file: " (mapcar 'list mh-alias-insert-file) nil t))))) ((and mh-alias-insert-file (stringp mh-alias-insert-file)) mh-alias-insert-file) @@ -490,16 +447,15 @@ contains it." (cond ((not autolist) (error "No writable alias file. -Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file")) +Set `mh-alias-insert-file' or the Aliasfile profile component")) ((not (elt autolist 1)) ; Only one entry, use it (car autolist)) ((or (not alias) (string-equal alias (mh-alias-ali alias))) ;alias doesn't exist - (completing-read "Alias file [press Tab]: " - (mapcar 'list autolist) nil t)) + (completing-read "Alias file: " (mapcar 'list autolist) nil t)) (t (or (mh-alias-which-file-has-alias alias autolist) - (completing-read "Alias file [press Tab]: " + (completing-read "Alias file: " (mapcar 'list autolist) nil t)))))))) ;;;###mh-autoload @@ -520,10 +476,8 @@ Set `mh-alias-insert-file' or set AliasFile in your .mh_profile file")) (split-string aliases ", +"))))))) ;;;###mh-autoload -(defun mh-alias-from-has-no-alias-p () - "Return t is From has no current alias set. -In the exceptional situation where there isn't a From header in the message the -function returns nil." +(defun mh-alias-for-from-p () + "Return t if sender's address has a corresponding alias." (mh-alias-reload-maybe) (save-excursion (if (not (mh-folder-line-matches-show-buffer-p)) @@ -532,13 +486,16 @@ function returns nil." (set-buffer mh-show-buffer)) (let ((from-header (mh-extract-from-header-value))) (and from-header - (not (mh-alias-address-to-alias from-header))))))) + (mh-alias-address-to-alias from-header)))))) (defun mh-alias-add-alias-to-file (alias address &optional file) "Add ALIAS for ADDRESS in alias FILE without alias check or prompts. Prompt for alias file if not provided and there is more than one candidate. -If ALIAS matches exactly, prompt to [i]nsert before old value or [a]ppend -after it." + +If the alias exists already, you will have the choice of inserting the new +alias before or after the old alias. In the former case, this alias will be +used when sending mail to this alias. In the latter case, the alias serves as +an additional folder name hint when filing messages." (if (not file) (setq file (mh-alias-insert-file alias))) (save-excursion @@ -552,14 +509,15 @@ after it." ((re-search-forward (concat "^" (regexp-quote alias-search) " *\\(.*\\)") nil t) (let ((answer (read-string - (format "Exists for %s; [i]nsert, [a]ppend: " + (format (concat "Alias %s exists; insert new address " + "[b]efore or [a]fter: ") (match-string 1)))) (case-fold-search t)) - (cond ((string-match "^i" answer)) + (cond ((string-match "^b" answer)) ((string-match "^a" answer) (forward-line 1)) (t - (error "Quitting"))))) + (error "Unrecognized response"))))) ;; No, so sort-in at the right place ;; search for "^alias", then "^alia", etc. ((eq mh-alias-insertion-location 'sorted) @@ -587,8 +545,11 @@ after it." ;;;###mh-autoload (defun mh-alias-add-alias (alias address) "*Add ALIAS for ADDRESS in personal alias file. -Prompts for confirmation if the address already has an alias. -If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." +This function prompts you for an alias and address. If the alias exists +already, you will have the choice of inserting the new alias before or after +the old alias. In the former case, this alias will be used when sending mail +to this alias. In the latter case, the alias serves as an additional folder +name hint when filing messages." (interactive "P\nP") (mh-alias-reload-maybe) (setq alias (completing-read "Alias: " mh-alias-alist nil nil alias)) @@ -614,9 +575,7 @@ If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." ;;;###mh-autoload (defun mh-alias-grab-from-field () - "*Add ALIAS for ADDRESS in personal alias file. -Prompts for confirmation if the alias is already in use or if the address -already has an alias." + "*Add alias for the sender of the current message." (interactive) (mh-alias-reload-maybe) (save-excursion @@ -636,24 +595,26 @@ already has an alias." ;;;###mh-autoload (defun mh-alias-add-address-under-point () - "Insert an alias for email address under point." + "Insert an alias for address under point." (interactive) (let ((address (mh-goto-address-find-address-at-point))) (if address (mh-alias-add-alias nil address) - (message "No email address found under point.")))) + (message "No email address found under point")))) ;;;###mh-autoload (defun mh-alias-apropos (regexp) - "Show all aliases that match REGEXP either in name or content." + "Show all aliases or addresses that match REGEXP." (interactive "sAlias regexp: ") (if mh-alias-local-users (mh-alias-reload-maybe)) - (let ((matches "")(group-matches "")(passwd-matches)) + (let ((matches "") + (group-matches "") + (passwd-matches)) (save-excursion (message "Reading MH aliases...") (mh-exec-cmd-quiet t "ali" "-nolist" "-nouser") - (message "Reading MH aliases...done. Parsing...") + (message "Parsing MH aliases...") (while (re-search-forward regexp nil t) (beginning-of-line) (cond @@ -673,10 +634,9 @@ already has an alias." (concat matches (buffer-substring (point)(progn (end-of-line)(point))) "\n"))))) - (message "Reading MH aliases...done. Parsing...done.") + (message "Parsing MH aliases...done") (when mh-alias-local-users - (message - "Reading MH aliases...done. Parsing...done. Passwd aliases...") + (message "Making passwd aliases...") (setq passwd-matches (mapconcat '(lambda (elem) @@ -684,13 +644,12 @@ already has an alias." (string-match regexp (cadr elem))) (format "%s: %s\n" (car elem) (cadr elem)))) mh-alias-passwd-alist "")) - (message - "Reading MH aliases...done. Parsing...done. Passwd aliases...done."))) + (message "Making passwd aliases...done"))) (if (and (string-equal "" matches) (string-equal "" group-matches) (string-equal "" passwd-matches)) (message "No matches") - (with-output-to-temp-buffer "*Help*" + (with-output-to-temp-buffer mh-aliases-buffer (if (not (string-equal "" matches)) (princ matches)) (when (not (string-equal group-matches "")) diff --git a/lisp/mh-e/mh-comp.el b/lisp/mh-e/mh-comp.el index 489b6690bc7..cde52c65043 100644 --- a/lisp/mh-e/mh-comp.el +++ b/lisp/mh-e/mh-comp.el @@ -33,11 +33,12 @@ ;;; Code: +(eval-when-compile (require 'mh-acros)) +(mh-require-cl) (require 'mh-e) (require 'gnus-util) (require 'easymenu) -(require 'mh-utils) -(mh-require-cl) +(require 'mh-gnus) (eval-when (compile load eval) (ignore-errors (require 'mailabbrev))) @@ -48,6 +49,7 @@ (defvar sendmail-coding-system) (defvar mh-identity-list) (defvar mh-identity-default) +(defvar mh-mml-mode-default) (defvar mh-identity-menu) ;;; Autoloads @@ -58,7 +60,7 @@ (autoload 'sc-cite-original "sc" "Workhorse citing function which performs the initial citation. This is callable from the various mail and news readers' reply -function according to the agreed upon standard. See `\\[sc-describe]' +function according to the agreed upon standard. See `sc-describe' for more details. `sc-cite-original' does not do any yanking of the original message but it does require a few things: @@ -95,14 +97,16 @@ If MH will not allow you to redist a previously redist'd msg, set to nil.") This allows transaction log to be visible if -watch, -verbose or -snoop are used.") -(defvar mh-note-repl "-" - "String whose first character is used to notate replied to messages.") +;;; Scan Line Formats + +(defvar mh-note-repl ?- + "Messages that have been replied to are marked by this character.") -(defvar mh-note-forw "F" - "String whose first character is used to notate forwarded messages.") +(defvar mh-note-forw ?F + "Messages that have been forwarded are marked by this character.") -(defvar mh-note-dist "R" - "String whose first character is used to notate redistributed messages.") +(defvar mh-note-dist ?R + "Messages that have been redistributed are marked by this character.") (defvar mh-yank-hooks nil "Obsolete hook for modifying a citation just inserted in the mail buffer. @@ -113,23 +117,6 @@ text as modified. This is a normal hook, misnamed for historical reasons. It is semi-obsolete and is only used if `mail-citation-hook' is nil.") -(defvar mail-citation-hook nil - "*Hook for modifying a citation just inserted in the mail buffer. -Each hook function can find the citation between point and mark. -And each hook function should leave point and mark around the citation -text as modified. - -If this hook is entirely empty (nil), the text of the message is inserted -with `mh-ins-buf-prefix' prefixed to each line. - -See also the variable `mh-yank-from-start-of-msg', which controls how -much of the message passed to the hook. - -This hook was historically provided to set up supercite. You may now leave -this nil and set up supercite by setting the variable -`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion, -to 'autosupercite.") - (defvar mh-comp-formfile "components" "Name of file to be used as a skeleton for composing messages. Default is \"components\". If not an absolute file name, the file @@ -145,7 +132,8 @@ system MH lib directory.") (defvar mh-repl-group-formfile "replgroupcomps" "Name of file to be used as a skeleton for replying to messages. This file is used to form replies to the sender and all recipients of a -message. Only used if `mh-nmh-flag' is non-nil. Default is \"replgroupcomps\". +message. Only used if `(mh-variant-p 'nmh)' is non-nil. +Default is \"replgroupcomps\". If not an absolute file name, the file is searched for first in the user's MH directory, then in the system MH lib directory.") @@ -153,6 +141,8 @@ directory, then in the system MH lib directory.") (format "^%s$" (regexp-opt '("Content-Type: message/rfc822" ;MIME MDN + "------ This is a copy of the message, including all the headers. ------";from exim + "--- Below this line is a copy of the message."; from qmail " ----- Unsent message follows -----" ;from sendmail V5 " --------Unsent Message below:" ; from sendmail at BU " ----- Original message follows -----" ;from sendmail V8 @@ -201,16 +191,16 @@ Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejecte "Field name for message annotation.") (defvar mh-insert-auto-fields-done-local nil - "Buffer-local variable set when `mh-insert-auto-fields' successfully called.") + "Buffer-local variable set when `mh-insert-auto-fields' called successfully.") (make-variable-buffer-local 'mh-insert-auto-fields-done-local) ;;;###autoload (defun mh-smail () "Compose and send mail with the MH mail system. -This function is an entry point to MH-E, the Emacs front end -to the MH mail system. +This function is an entry point to MH-E, the Emacs interface to the MH mail +system. -See documentation of `\\[mh-send]' for more details on composing mail." +See `mh-send' for more details on composing mail." (interactive) (mh-find-path) (call-interactively 'mh-send)) @@ -220,11 +210,11 @@ See documentation of `\\[mh-send]' for more details on composing mail." ;;;###autoload (defun mh-smail-batch (&optional to subject other-headers &rest ignored) "Set up a mail composition draft with the MH mail system. -This function is an entry point to MH-E, the Emacs front end -to the MH mail system. This function does not prompt the user -for any header fields, and thus is suitable for use by programs -that want to create a mail buffer. -Users should use `\\[mh-smail]' to compose mail. +This function is an entry point to MH-E, the Emacs interface to the MH mail +system. This function does not prompt the user for any header fields, and thus +is suitable for use by programs that want to create a mail buffer. Users +should use `mh-smail' to compose mail. + Optional arguments for setting certain fields include TO, SUBJECT, and OTHER-HEADERS. Additional arguments are IGNORED." (mh-find-path) @@ -260,7 +250,8 @@ CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are ignored." "Clean up a draft or a message MSG previously sent and make it resendable. Default is the current message. The variable `mh-new-draft-cleaned-headers' specifies the headers to remove. -See also documentation for `\\[mh-send]' function." + +See also `mh-send'." (interactive (list (mh-get-msg-num t))) (let* ((from-folder mh-current-folder) (config (current-window-configuration)) @@ -292,7 +283,8 @@ See also documentation for `\\[mh-send]' function." "Extract message MSG returned by the mail system and make it resendable. Default is the current message. The variable `mh-new-draft-cleaned-headers' gives the headers to clean out of the original message. -See also documentation for `\\[mh-send]' function." + +See also `mh-send'." (interactive (list (mh-get-msg-num t))) (let ((from-folder mh-current-folder) (config (current-window-configuration)) @@ -303,7 +295,7 @@ See also documentation for `\\[mh-send]' function." (delete-region (point-min) (point)) (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)) (t - (message "Does not appear to be a rejected letter."))) + (message "Does not appear to be a rejected letter"))) (mh-insert-header-separator) (goto-char (point-min)) (save-buffer) @@ -323,7 +315,7 @@ Default is the displayed message. Check the documentation of `mh-interactive-range' to see how RANGE is read in interactive use. -See also documentation for `\\[mh-send]' function." +See also `mh-send'." (interactive (list (mh-interactive-read-address "To: ") (mh-interactive-read-address "Cc: ") (mh-interactive-range "Forward"))) @@ -335,7 +327,10 @@ See also documentation for `\\[mh-send]' function." (draft-name (expand-file-name "draft" mh-user-path)) (draft (cond ((or (not (file-exists-p draft-name)) (y-or-n-p "The file 'draft' exists. Discard it? ")) - (mh-exec-cmd "forw" "-build" (if mh-nmh-flag "-mime") + (mh-exec-cmd "forw" "-build" + (if (and (mh-variant-p 'nmh) + mh-compose-forward-as-mime-flag) + "-mime") mh-current-folder (mh-coalesce-msg-list msgs)) (prog1 @@ -388,7 +383,8 @@ See also documentation for `\\[mh-send]' function." mh-note-forw "Forwarded:" config) (mh-letter-mode-message) - (mh-letter-adjust-point))))) + (mh-letter-adjust-point) + (run-hooks 'mh-forward-hook))))) (defun mh-forwarded-letter-subject (from subject) "Return a Subject suitable for a forwarded message. @@ -406,10 +402,10 @@ Original message has headers FROM and SUBJECT." ;;;###autoload (defun mh-smail-other-window () "Compose and send mail in other window with the MH mail system. -This function is an entry point to MH-E, the Emacs front end -to the MH mail system. +This function is an entry point to MH-E, the Emacs interface to the MH mail +system. -See documentation of `\\[mh-send]' for more details on composing mail." +See `mh-send' for more details on composing mail." (interactive) (mh-find-path) (call-interactively 'mh-send-other-window)) @@ -496,13 +492,15 @@ to reply to: If optional prefix argument INCLUDEP provided, then include the message in the reply using filter `mhl.reply' in your MH directory. If the file named by `mh-repl-formfile' exists, it is used as a skeleton -for the reply. See also documentation for `\\[mh-send]' function." +for the reply. + +See also `mh-send'." (interactive (list (mh-get-msg-num t) (let ((minibuffer-help-form "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients")) (or mh-reply-default-reply-to - (completing-read "Reply to whom? (from, to, all) [from]: " + (completing-read "Reply to whom: [from] " '(("from") ("to") ("cc") ("all")) nil t))) @@ -511,7 +509,7 @@ for the reply. See also documentation for `\\[mh-send]' function." (show-buffer mh-show-buffer) (config (current-window-configuration)) (group-reply (or (equal reply-to "cc") (equal reply-to "all"))) - (form-file (cond ((and mh-nmh-flag group-reply + (form-file (cond ((and (mh-variant-p 'nmh 'mu-mh) group-reply (stringp mh-repl-group-formfile)) mh-repl-group-formfile) ((stringp mh-repl-formfile) mh-repl-formfile) @@ -525,7 +523,7 @@ for the reply. See also documentation for `\\[mh-send]' function." '("-nocc" "all")) ((equal reply-to "to") '("-cc" "to")) - (group-reply (if mh-nmh-flag + (group-reply (if (mh-variant-p 'nmh 'mu-mh) '("-group" "-nocc" "me") '("-cc" "all" "-nocc" "me")))) (cond ((or (eq mh-yank-from-start-of-msg 'autosupercite) @@ -562,7 +560,6 @@ for the reply. See also documentation for `\\[mh-send]' function." ;;;###mh-autoload (defun mh-send (to cc subject) "Compose and send a letter. - Do not call this function from outside MH-E; use \\[mh-smail] instead. The file named by `mh-comp-formfile' will be used as the form. @@ -581,7 +578,6 @@ passed three arguments: TO, CC, and SUBJECT." ;;;###mh-autoload (defun mh-send-other-window (to cc subject) "Compose and send a letter in another window. - Do not call this function from outside MH-E; use \\[mh-smail-other-window] instead. @@ -711,6 +707,8 @@ Do not insert any pairs whose value is the empty string." (while name-values (let ((field-name (car name-values)) (value (car (cdr name-values)))) + (if (not (string-match "^.*:$" field-name)) + (setq field-name (concat field-name ":"))) (cond ((equal value "") nil) ((mh-position-on-field field-name) @@ -730,6 +728,7 @@ The optional second arg is for pre-version 4 compatibility and is IGNORED." ((mh-goto-header-end 0) nil))) +;;;###mh-autoload (defun mh-get-header-field (field) "Find and return the body of FIELD in the mail header. Returns the empty string if the field is not in the header of the @@ -777,35 +776,53 @@ Returns t if found, nil if not." ;;; Menu extracted from mh-menubar.el V1.1 (31 July 2001) (eval-when-compile (defvar mh-letter-menu nil)) -(cond - ((fboundp 'easy-menu-define) - (easy-menu-define - mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode." - '("Letter" - ["Send This Draft" mh-send-letter t] - ["Split Current Line" mh-open-line t] - ["Check Recipient" mh-check-whom t] - ["Yank Current Message" mh-yank-cur-msg t] - ["Insert a Message..." mh-insert-letter t] - ["Insert Signature" mh-insert-signature t] - ["GPG Sign message" - mh-mml-secure-message-sign-pgpmime mh-gnus-pgp-support-flag] - ["GPG Encrypt message" - mh-mml-secure-message-encrypt-pgpmime mh-gnus-pgp-support-flag] - ["Compose Insertion (MIME)..." mh-compose-insertion t] - ;; ["Compose Compressed tar (MIME)..." - ;;mh-mhn-compose-external-compressed-tar t] - ;; ["Compose Anon FTP (MIME)..." mh-mhn-compose-anon-ftp t] - ["Compose Forward (MIME)..." mh-compose-forward t] - ;; The next two will have to be merged. But I also need to make sure the - ;; user can't mix directives of both types. - ["Pull in All Compositions (mhn)" - mh-edit-mhn (mh-mhn-directive-present-p)] - ["Pull in All Compositions (gnus)" - mh-mml-to-mime (mh-mml-directive-present-p)] - ["Revert to Non-MIME Edit (mhn)" - mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)] - ["Kill This Draft" mh-fully-kill-draft t])))) +(easy-menu-define + mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode." + '("Letter" + ["Send This Draft" mh-send-letter t] + ["Split Current Line" mh-open-line t] + ["Check Recipient" mh-check-whom t] + ["Yank Current Message" mh-yank-cur-msg t] + ["Insert a Message..." mh-insert-letter t] + ["Insert Signature" mh-insert-signature t] + ("Encrypt/Sign Message" + ["Sign Message" + mh-mml-secure-message-sign mh-gnus-pgp-support-flag] + ["Encrypt Message" + mh-mml-secure-message-encrypt mh-gnus-pgp-support-flag] + ["Sign+Encrypt Message" + mh-mml-secure-message-signencrypt mh-gnus-pgp-support-flag] + ["Disable Security" + mh-mml-unsecure-message mh-gnus-pgp-support-flag] + "--" + "Security Method" + ["PGP (MIME)" (setq mh-mml-method-default "pgpmime") + :style radio + :selected (equal mh-mml-method-default "pgpmime")] + ["PGP" (setq mh-mml-method-default "pgp") + :style radio + :selected (equal mh-mml-method-default "pgp")] + ["S/MIME" (setq mh-mml-method-default "smime") + :style radio + :selected (equal mh-mml-method-default "smime")] + "--" + ["Save Method as Default" + (customize-save-variable 'mh-mml-method-default mh-mml-method-default) t] + ) + ["Compose Insertion (MIME)..." mh-compose-insertion t] + ["Compose Compressed tar (MIME)..." + mh-mhn-compose-external-compressed-tar t] + ["Compose Get File (MIME)..." mh-mhn-compose-anon-ftp t] + ["Compose Forward (MIME)..." mh-compose-forward t] + ;; The next two will have to be merged. But I also need to make sure the + ;; user can't mix directives of both types. + ["Pull in All Compositions (mhn)" + mh-edit-mhn (mh-mhn-directive-present-p)] + ["Pull in All Compositions (gnus)" + mh-mml-to-mime (mh-mml-directive-present-p)] + ["Revert to Non-MIME Edit (mhn)" + mh-revert-mhn-edit (equal mh-compose-insertion 'mhn)] + ["Kill This Draft" mh-fully-kill-draft t])) ;;; Help Messages ;;; Group messages logically, more or less. @@ -817,12 +834,15 @@ Returns t if found, nil if not." "\t\tInsert:\n" "Check recipients: \\[mh-check-whom]" "\t\t Current message: \\[mh-yank-cur-msg]\n" - "Encrypt message: \\[mh-mml-secure-message-encrypt-pgpmime]" - "\t\t Attachment: \\[mh-compose-insertion]\n" - "Sign message: \\[mh-mml-secure-message-sign-pgpmime]" - "\t\t Message to forward: \\[mh-compose-forward]\n" + "\t\t Attachment: \\[mh-compose-insertion]\n" + "\t\t Message to forward: \\[mh-compose-forward]\n" + " " + "Security:" + "\t\t Encrypt message: \\[mh-mml-secure-message-encrypt]" + "\t\t Sign+Encrypt message: \\[mh-mml-secure-message-signencrypt]" + "\t\t Sign message: \\[mh-mml-secure-message-sign]\n" " " - "\t\t Signature: \\[mh-insert-signature]")) + "\t\t Signature: \\[mh-insert-signature]")) "Key binding cheat sheet. This is an associative array which is used to show the most common commands. @@ -872,13 +892,19 @@ When a message is composed, the hooks `text-mode-hook' and `mh-letter-mode-hook' are run. \\{mh-letter-mode-map}" - (or mh-user-path (mh-find-path)) + (mh-find-path) (make-local-variable 'mh-send-args) (make-local-variable 'mh-annotate-char) (make-local-variable 'mh-annotate-field) (make-local-variable 'mh-previous-window-config) (make-local-variable 'mh-sent-from-folder) (make-local-variable 'mh-sent-from-msg) + ;; Set the local value of mh-mail-header-separator according to what is + ;; present in the buffer... + (set (make-local-variable 'mh-mail-header-separator) + (save-excursion + (goto-char (mh-mail-header-end)) + (buffer-substring-no-properties (point) (line-end-position)))) (make-local-variable 'mail-header-separator) (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el (make-local-variable 'mh-help-messages) @@ -886,12 +912,6 @@ When a message is composed, the hooks `text-mode-hook' and (setq buffer-invisibility-spec '((vanish . t) t)) (set (make-local-variable 'line-move-ignore-invisible) t) - ;; Set mh-mail-header-end-marker to remember end of message header. - (set (make-local-variable 'mh-letter-mail-header-end-marker) - (set-marker (make-marker) (save-excursion - (goto-char (mh-mail-header-end)) - (line-beginning-position 2)))) - ;; From sendmail.el for proper paragraph fill ;; sendmail.el also sets a normal-auto-fill-function (not done here) (make-local-variable 'paragraph-separate) @@ -965,11 +985,15 @@ When a message is composed, the hooks `text-mode-hook' and t))) (defun mh-letter-header-end () - "Find the end of header from `mh-letter-mail-header-end-marker'." + "Find the end of the message header. +This function is to be used only for font locking. It works by searching for +`mh-mail-header-separator' in the buffer." (save-excursion - (goto-char (marker-position mh-letter-mail-header-end-marker)) - (forward-line -1) - (point))) + (goto-char (point-min)) + (cond ((equal mh-mail-header-separator "") (point-min)) + ((search-forward (format "\n%s\n" mh-mail-header-separator) nil t) + (line-beginning-position 0)) + (t (point-min))))) (defun mh-auto-fill-for-letter () "Perform auto-fill for message. @@ -1041,16 +1065,69 @@ Prompt for the field name with a completion list of the current folders." (substring folder 1) folder))))) +(defun mh-file-is-vcard-p (file) + "Return t if FILE is a .vcf vcard." + (let ((case-fold-search t)) + (and (stringp file) + (file-exists-p file) + (or (and (not (mh-have-file-command)) + (not (null (string-match "\.vcf$" file)))) + (and (mh-have-file-command) + (string-equal "text/x-vcard" (mh-file-mime-type file))))))) + ;;;###mh-autoload -(defun mh-insert-signature () - "Insert the file named by `mh-signature-file-name' at point. +(defun mh-insert-signature (&optional file) + "Insert the signature specified by `mh-signature-file-name' or FILE at point. +A signature separator (`-- ') will be added if the signature block does not +contain one and `mh-signature-separator-flag' is on. The value of `mh-letter-insert-signature-hook' is a list of functions to be -called, with no arguments, before the signature is actually inserted." - (interactive) - (let ((mh-signature-file-name mh-signature-file-name)) - (run-hooks 'mh-letter-insert-signature-hook) - (if mh-signature-file-name - (insert-file-contents mh-signature-file-name))) +called, with no arguments, after the signature is inserted. +The signature can also be inserted with `mh-identity-list'." +(interactive) + (save-excursion + (insert "\n") + (let ((mh-signature-file-name (or file mh-signature-file-name)) + (mh-mhn-p (mh-mhn-directive-present-p)) + (mh-mml-p (mh-mml-directive-present-p))) + (save-restriction + (narrow-to-region (point) (point)) + (cond + ((mh-file-is-vcard-p mh-signature-file-name) + (if (equal mh-compose-insertion 'gnus) + (insert "<#part type=\"text/x-vcard\" filename=\"" + mh-signature-file-name + "\" disposition=inline description=VCard>\n<#/part>") + (insert "#text/x-vcard; name=\"" + (file-name-nondirectory mh-signature-file-name) + "\" [VCard] " (expand-file-name mh-signature-file-name)))) + (t + (cond + (mh-mhn-p + (insert "#\n" "Content-Description: Signature\n")) + (mh-mml-p + (mml-insert-tag 'part 'type "text/plain" 'disposition "inline" + 'description "Signature"))) + (cond ((null mh-signature-file-name)) + ((and (stringp mh-signature-file-name) + (file-readable-p mh-signature-file-name)) + (insert-file-contents mh-signature-file-name)) + ((functionp mh-signature-file-name) + (funcall mh-signature-file-name))))) + (save-restriction + (widen) + (run-hooks 'mh-letter-insert-signature-hook)) + (goto-char (point-min)) + (when (and (not (mh-file-is-vcard-p mh-signature-file-name)) + mh-signature-separator-flag + (> (point-max) (point-min)) + (not (mh-signature-separator-p))) + (cond (mh-mhn-p + (forward-line 2)) + (mh-mml-p + (forward-line 1))) + (insert mh-signature-separator)) + (if (not (> (point-max) (point-min))) + (message "No signature found"))))) (force-mode-line-update)) ;;;###mh-autoload @@ -1100,33 +1177,18 @@ MH the first time a message is composed.") (defun mh-insert-x-mailer () "Append an X-Mailer field to the header. The versions of MH-E, Emacs, and MH are shown." - ;; Lazily initialize mh-x-mailer-string. (when (and mh-insert-x-mailer-flag (null mh-x-mailer-string)) - (save-window-excursion - ;; User would be confused if version info buffer disappeared magically, - ;; so don't delete buffer if it already existed. - (let ((info-buffer-exists-p (get-buffer mh-info-buffer))) - (mh-version) - (set-buffer mh-info-buffer) - (if mh-nmh-flag - (search-forward-regexp "^nmh-\\(\\S +\\)") - (search-forward-regexp "^MH \\(\\S +\\)" nil t)) - (let ((x-mailer-mh (buffer-substring (match-beginning 1) - (match-end 1)))) - (setq mh-x-mailer-string - (format "MH-E %s; %s %s; %sEmacs %s" - mh-version (if mh-nmh-flag "nmh" "MH") x-mailer-mh - (if mh-xemacs-flag "X" "GNU ") - (cond ((not mh-xemacs-flag) emacs-version) - ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?" - emacs-version) - (match-string 0 emacs-version)) - (t (format "%s.%s" - emacs-major-version - emacs-minor-version)))))) - (if (not info-buffer-exists-p) - (kill-buffer mh-info-buffer))))) + (setq mh-x-mailer-string + (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) + ((string-match "[0-9.]*\\( +\([ a-z]+[0-9]+\)\\)?" + emacs-version) + (match-string 0 emacs-version)) + (t (format "%s.%s" emacs-major-version + emacs-minor-version)))))) ;; Insert X-Mailer, but only if it doesn't already exist. (save-excursion (when (and mh-insert-x-mailer-flag @@ -1155,25 +1217,31 @@ Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted something. If NON-INTERACTIVE is non-nil, do not be verbose and only attempt matches if `mh-insert-auto-fields-done-local' is nil. -An `identity' entry is skipped if one was already entered manually." +An `identity' entry is skipped if one was already entered manually. + +Return t if fields added; otherwise return nil." (interactive) - (when (or (not non-interactive) (not mh-insert-auto-fields-done-local)) + (when (or (not non-interactive) + (not mh-insert-auto-fields-done-local)) (save-excursion - (when (and (or (mh-goto-header-field "To:")(mh-goto-header-field "cc:"))) - (let ((list mh-auto-fields-list)) + (when (and (or (mh-goto-header-field "To:") + (mh-goto-header-field "cc:"))) + (let ((list mh-auto-fields-list) + (fields-inserted nil)) (while list (let ((regexp (nth 0 (car list))) (entries (nth 1 (car list)))) (when (mh-regexp-in-field-p regexp "To:" "cc:") (setq mh-insert-auto-fields-done-local t) + (setq fields-inserted t) (if (not non-interactive) - (message "Matched for regexp %s" regexp)) + (message "Fields for %s added" regexp)) (let ((entry-list entries)) (while entry-list (let ((field (caar entry-list)) (value (cdar entry-list))) (cond - ((equal "identity" field) + ((equal ":identity" field) (when (and (not mh-identity-local) (assoc value mh-identity-list)) (mh-insert-identity value))) @@ -1181,7 +1249,8 @@ An `identity' entry is skipped if one was already entered manually." (mh-modify-header-field field value (equal field "From"))))) (setq entry-list (cdr entry-list)))))) - (setq list (cdr list)))))))) + (setq list (cdr list))) + fields-inserted))))) (defun mh-modify-header-field (field value &optional overwrite-flag) "To header FIELD add VALUE. @@ -1201,8 +1270,6 @@ If OVERWRITE-FLAG is non-nil then the old value, if present, is discarded." (mh-goto-header-end 0) (insert field ": " value "\n")))) -(defvar mh-letter-mail-header-end-marker nil) - (defun mh-compose-and-send-mail (draft send-args sent-from-folder sent-from-msg to subject cc @@ -1221,22 +1288,19 @@ for `mh-annotate-msg'. CONFIG is the window configuration to restore after sending the letter." (pop-to-buffer draft) (mh-letter-mode) - (mh-insert-auto-fields t) - ;; mh-identity support + ;; Insert identity. (if (and (boundp 'mh-identity-default) mh-identity-default (not mh-identity-local)) (mh-insert-identity mh-identity-default)) - (when (and (boundp 'mh-identity-list) - mh-identity-list) - (mh-identity-make-menu) - (easy-menu-add mh-identity-menu)) + (mh-identity-make-menu) + (easy-menu-add mh-identity-menu) - ;; Extra fields + ;; Insert extra fields. (mh-insert-x-mailer) (mh-insert-x-face) - ;; Hide skipped fields + (mh-letter-hide-all-skipped-fields) (setq mh-sent-from-folder sent-from-folder) @@ -1264,7 +1328,16 @@ CONFIG is the window configuration to restore after sending the letter." This should be the last function called when composing the draft." (message "%s" (substitute-command-keys (concat "Type \\[mh-send-letter] to send message, " - "\\[mh-help] for help.")))) + "\\[mh-help] for help")))) + +(defun mh-ascii-buffer-p () + "Check if current buffer is entirely composed of ASCII. +The function doesn't work for XEmacs since `find-charset-region' doesn't exist +there." + (loop for charset in (mh-funcall-if-exists + find-charset-region (point-min) (point-max)) + unless (eq charset 'ascii) return nil + finally return t)) ;;;###mh-autoload (defun mh-send-letter (&optional arg) @@ -1273,15 +1346,17 @@ If optional prefix argument ARG is provided, monitor delivery. The value of `mh-before-send-letter-hook' is a list of functions to be called, with no arguments, before doing anything. Run `\\[mh-edit-mhn]' if mhn directives are present; otherwise -run `\\[mh-mml-to-mime]' if mml directives are present. -Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set. -Insert X-Face field if the file specified by `mh-x-face-file' exists." +run `\\[mh-mml-to-mime]' if mml directives are present." (interactive "P") (run-hooks 'mh-before-send-letter-hook) - (mh-insert-auto-fields t) + (if (and (mh-insert-auto-fields t) + mh-auto-fields-prompt-flag + (goto-char (point-min))) + (if (not (y-or-n-p "Auto fields inserted, send? ")) + (error "Send aborted"))) (cond ((mh-mhn-directive-present-p) (mh-edit-mhn)) - ((mh-mml-directive-present-p) + ((or (mh-mml-directive-present-p) (not (mh-ascii-buffer-p))) (mh-mml-to-mime))) (save-buffer) (message "Sending...") @@ -1302,7 +1377,7 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists." 'iso-latin-1)))) ;; The default BCC encapsulation will make a MIME message unreadable. ;; With nmh use the -mime arg to prevent this. - (if (and mh-nmh-flag + (if (and (mh-variant-p 'nmh) (mh-goto-header-field "Bcc:") (mh-goto-header-field "Content-Type:")) (setq mh-send-args (format "-mime %s" mh-send-args))) @@ -1338,7 +1413,8 @@ Insert X-Face field if the file specified by `mh-x-face-file' exists." ;;;###mh-autoload (defun mh-insert-letter (folder message verbatim) "Insert a message into the current letter. -Removes the header fields according to the variable `mh-invisible-headers'. +Removes the header fields according to the variable +`mh-invisible-header-fields-compiled'. Prefixes each non-blank line with `mh-ins-buf-prefix', unless `mh-yank-from-start-of-msg' is set for supercite in which case supercite is used to format the message. @@ -1355,11 +1431,12 @@ and point after it." (save-restriction (narrow-to-region (point) (point)) (let ((start (point-min))) - (if (equal message "") (setq message (int-to-string mh-sent-from-msg))) + (if (and (equal message "") (numberp mh-sent-from-msg)) + (setq message (int-to-string mh-sent-from-msg))) (insert-file-contents (expand-file-name message (mh-expand-file-name folder))) (when (not verbatim) - (mh-clean-msg-header start mh-invisible-headers mh-visible-headers) + (mh-clean-msg-header start mh-invisible-header-fields-compiled nil) (goto-char (point-max)) ;Needed for sc-cite-original (push-mark) ;Needed for sc-cite-original (goto-char (point-min)) ;Needed for sc-cite-original @@ -1373,15 +1450,13 @@ and point after it." (skip-chars-forward " ") (cond ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)") - (format "%s %s %s" (match-string 1)(match-string 2) - mh-extract-from-attribution-verb)) + (format "%s %s " (match-string 1)(match-string 2))) ((looking-at "\\([^<\n]+<.+>\\)$") - (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)) + (format "%s " (match-string 1))) ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$") - (format "%s <%s> %s" (match-string 2)(match-string 1) - mh-extract-from-attribution-verb)) + (format "%s <%s> " (match-string 2)(match-string 1))) ((looking-at " *\\(.+\\)$") - (format "%s %s" (match-string 1) mh-extract-from-attribution-verb)))))) + (format "%s " (match-string 1))))))) ;;;###mh-autoload (defun mh-yank-cur-msg () @@ -1444,9 +1519,11 @@ yanked message will be deleted." (push-mark) ;Needed for sc-cite-original (goto-char (point-min)) ;Needed for sc-cite-original (mh-insert-prefix-string mh-ins-buf-prefix) - (if (or (eq 'attribution mh-yank-from-start-of-msg) - (eq 'autoattrib mh-yank-from-start-of-msg)) - (insert from-attr "\n\n")) + (when (or (eq 'attribution mh-yank-from-start-of-msg) + (eq 'autoattrib mh-yank-from-start-of-msg)) + (insert from-attr) + (mh-identity-insert-attribution-verb nil) + (insert "\n\n")) ;; If the user has selected a region, he has already "edited" the ;; text, so leave the cursor at the end of the yanked text. In ;; either case, leave a mark at the opposite end of the included @@ -1572,7 +1649,7 @@ Any match found replaces the text from BEGIN to END." (let ((syntax-table (syntax-table))) (unwind-protect (save-excursion - (mh-funcall-if-exists mail-abbrev-make-syntax-table) + (mh-mail-abbrev-make-syntax-table) (set-syntax-table mail-abbrev-syntax-table) (backward-word n) (point)) @@ -1593,7 +1670,6 @@ Any match found replaces the text from BEGIN to END." (mh-folder-completion-function folder nil t)))) (mh-complete-word folder choices beg end))) -;; XXX: This should probably be customizable (defvar mh-letter-complete-function-alist '((cc . mh-alias-letter-expand-alias) (bcc . mh-alias-letter-expand-alias) @@ -1607,10 +1683,10 @@ Any match found replaces the text from BEGIN to END." (defun mh-letter-complete (arg) "Perform completion on header field or word preceding point. -Alias completion is done within the mail header on selected fields based on -the matches in `mh-letter-complete-function-alist'. Elsewhere the function -designated by `mh-letter-complete-function' is used and given the prefix ARG, -if present." +If the field contains addresses (for example, `To:' or `Cc:') or folders (for +example, `Fcc:') then this function will provide alias completion. Elsewhere, +this function runs `mh-letter-complete-function' instead and passes the prefix +ARG, if present." (interactive "P") (let ((func nil)) (cond ((not (mh-in-header-p)) @@ -1832,10 +1908,13 @@ Otherwise return the empty string." ;;; Build the letter-mode keymap: ;;; If this changes, modify mh-letter-mode-help-messages accordingly, above. (gnus-define-keys mh-letter-mode-map + " " mh-letter-complete-or-space + "," mh-letter-confirm-address "\C-c?" mh-help + "\C-c\C-\\" mh-fully-kill-draft ;if no C-q + "\C-c\C-^" mh-insert-signature ;if no C-s "\C-c\C-c" mh-send-letter "\C-c\C-d" mh-insert-identity - "\C-c\M-d" mh-insert-auto-fields "\C-c\C-e" mh-edit-mhn "\C-c\C-f\C-b" mh-to-field "\C-c\C-f\C-c" mh-to-field @@ -1852,31 +1931,38 @@ Otherwise return the empty string." "\C-c\C-fs" mh-to-field "\C-c\C-ft" mh-to-field "\C-c\C-i" mh-insert-letter - "\C-c\C-m\C-e" mh-mml-secure-message-encrypt-pgpmime + "\C-c\C-m\C-e" mh-mml-secure-message-encrypt "\C-c\C-m\C-f" mh-compose-forward + "\C-c\C-m\C-g" mh-mhn-compose-anon-ftp "\C-c\C-m\C-i" mh-compose-insertion "\C-c\C-m\C-m" mh-mml-to-mime - "\C-c\C-m\C-s" mh-mml-secure-message-sign-pgpmime + "\C-c\C-m\C-n" mh-mml-unsecure-message + "\C-c\C-m\C-s" mh-mml-secure-message-sign + "\C-c\C-m\C-t" mh-mhn-compose-external-compressed-tar "\C-c\C-m\C-u" mh-revert-mhn-edit - "\C-c\C-me" mh-mml-secure-message-encrypt-pgpmime + "\C-c\C-m\C-x" mh-mhn-compose-external-type + "\C-c\C-mee" mh-mml-secure-message-encrypt + "\C-c\C-mes" mh-mml-secure-message-signencrypt "\C-c\C-mf" mh-compose-forward + "\C-c\C-mg" mh-mhn-compose-anon-ftp "\C-c\C-mi" mh-compose-insertion "\C-c\C-mm" mh-mml-to-mime - "\C-c\C-ms" mh-mml-secure-message-sign-pgpmime + "\C-c\C-mn" mh-mml-unsecure-message + "\C-c\C-mse" mh-mml-secure-message-signencrypt + "\C-c\C-mss" mh-mml-secure-message-sign + "\C-c\C-mt" mh-mhn-compose-external-compressed-tar "\C-c\C-mu" mh-revert-mhn-edit + "\C-c\C-mx" mh-mhn-compose-external-type "\C-c\C-o" mh-open-line "\C-c\C-q" mh-fully-kill-draft - "\C-c\C-\\" mh-fully-kill-draft ;if no C-q "\C-c\C-s" mh-insert-signature - "\C-c\C-^" mh-insert-signature ;if no C-s + "\C-c\C-t" mh-letter-toggle-header-field-display "\C-c\C-w" mh-check-whom "\C-c\C-y" mh-yank-cur-msg - "\C-c\C-t" mh-letter-toggle-header-field-display - " " mh-letter-complete-or-space + "\C-c\M-d" mh-insert-auto-fields "\M-\t" mh-letter-complete "\t" mh-letter-next-header-field-or-indent - [backtab] mh-letter-previous-header-field - "," mh-letter-confirm-address) + [backtab] mh-letter-previous-header-field) ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el. diff --git a/lisp/mh-e/mh-customize.el b/lisp/mh-e/mh-customize.el index 2ce36c88726..622c457897f 100644 --- a/lisp/mh-e/mh-customize.el +++ b/lisp/mh-e/mh-customize.el @@ -34,814 +34,591 @@ ;; ;; 1. MH-E Customization Groups ;; -;; These are the customization group definitions. These are organized in a -;; logical order. High-level, windows and toolbar, folder, message, -;; composing and hooks. +;; These are the customization group definitions. Every group has a +;; associated manual node. The ordering is alphabetical, except for the +;; groups mh-faces and mh-hooks which are last . ;; ;; 2. MH-E Customization ;; -;; Here are the actual customization variables. There is a sub-section for -;; each group in the MH-E Customization Groups section. Within each -;; section, variables are sorted alphabetically. The manual section -;; dictates which group a variable should be placed. New variables should -;; be placed in the section where they would most likely be defined. +;; These are the actual customization variables. There is a sub-section for +;; each group in the MH-E Customization Groups section, in the same order, +;; separated by page breaks. Within each section, variables are sorted +;; alphabetically. ;; -;; All hooks should be placed in the 'mh-hook group; in addition, add the -;; group in which the hook is defined in the manual (or, if it is new, -;; where it would be defined). These two actions insures that the hooks -;; appear last in each group. +;; 3. Hooks +;; +;; All hooks must be placed in the mh-hook group; in addition, add the +;; group associated with the manual node in which the hook is described. +;; Since the mh-hook group appears near the end of this file, the hooks +;; will appear at the end of these other groups. +;; +;; 4. Faces +;; +;; Create a new face group if necessary; in this case, add the group +;; associated with the manual node in which the faces are described to the +;; faces' group definition. Since the face groups appear last, the face +;; groups will appear at the end of these other groups. ;; -;; 3. Faces - ;;; Change Log: ;;; Code: + (provide 'mh-customize) -(require 'mh-utils) + +(eval-when-compile (require 'mh-acros)) +(mh-require-cl) +(require 'mh-loaddefs) + +(autoload 'Info-goto-node "info") + +(eval-and-compile + (defvar mh-xemacs-flag (featurep 'xemacs) + "Non-nil means the current Emacs is XEmacs.")) (when mh-xemacs-flag (require 'mh-xemacs)) -;;;###mh-autoload +;; XXX: Functions autoloaded from the following files are used to initialize +;; customizable variables. They are require'd here, since otherwise the +;; corresponding .elc would be loaded at compile time. +(eval-when-compile + (require 'mh-init) + (require 'mh-identity)) + (defun mh-customize (&optional delete-other-windows-flag) "Customize MH-E variables. -With optional argument DELETE-OTHER-WINDOWS-FLAG, other windows in the frame -are removed." +If optional argument DELETE-OTHER-WINDOWS-FLAG is non-nil, other windows in +the frame are removed." (interactive "P") (customize-group 'mh) (when delete-other-windows-flag (delete-other-windows))) + + +;;; For compiler warnings... +(defvar mh-show-buffer) +(defvar mh-show-folder-buffer) + ;;; MH-E Customization Groups (defgroup mh nil - "GNU Emacs interface to the MH mail system." + "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) -(defgroup mh-toolbar nil - "Toolbar configuration." - :prefix "mh-" +(defgroup mh-e '((mh custom-group)) ; Sort of an alias for 'mh group + "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")) + +(defgroup mh-alias nil + "Aliases." + :link '(custom-manual "(mh-e)Aliases") + :prefix "mh-alias-" :group 'mh) -(defgroup mh-speed nil - "Speedbar and folder configuration." +(defgroup mh-folder nil + "Organizing your mail with folders." :prefix "mh-" - :link '(custom-manual "(mh-e)Customizing Moving Mail") + :link '(custom-manual "(mh-e)Organizing") :group 'mh) -(defgroup mh-folder nil - "Options for controlling scan listing." +(defgroup mh-folder-selection nil + "Folder selection." :prefix "mh-" - :link '(custom-manual "(mh-e)Customizing Moving Mail") + :link '(custom-manual "(mh-e)Folder Selection") + :group 'mh) + +(defgroup mh-identity nil + "Identities." + :link '(custom-manual "(mh-e)Identities") + :prefix "mh-identity-" + :group 'mh) + +(defgroup mh-inc nil + "Incorporating your mail." + :prefix "mh-inc-" + :link '(custom-manual "(mh-e)Incorporating Mail") :group 'mh) (defgroup mh-index nil - "Indexed searching." - :link '(custom-manual "(mh-e)Customizing mh-e") - :prefix "mh-" + "Searching." + :link '(custom-manual "(mh-e)Searching") + :prefix "mh-index-" :group 'mh) (defgroup mh-junk nil - "Spam handling." - :link '(custom-manual "(mh-e)Customizing mh-e") + "Dealing with junk mail." + :link '(custom-manual "(mh-e)Junk") :prefix "mh-junk-" :group 'mh) -(defgroup mh-show nil - "Message display." +(defgroup mh-letter nil + "Editing a draft." :prefix "mh-" - :link '(custom-manual "(mh-e)Customizing Reading") + :link '(custom-manual "(mh-e)Editing Drafts") :group 'mh) -(defgroup mh-faces nil - "Faces used in MH-E." - :link '(custom-manual "(mh-e)Customizing mh-e") +(defgroup mh-ranges nil + "Ranges." :prefix "mh-" - :group 'faces + :link '(custom-manual "(mh-e)Ranges") :group 'mh) -(defgroup mh-letter nil - "Composing messages." +(defgroup mh-scan-line-formats nil + "Scan line formats." + :link '(custom-manual "(mh-e)Scan Line Formats") :prefix "mh-" - :link '(custom-manual "(mh-e)Customizing Sending") :group 'mh) -(defgroup mh-alias nil - "Alias handling." - :link '(custom-manual "(mh-e)Customizing mh-e") - :prefix "mh-alias-" +(defgroup mh-sending-mail nil + "Sending mail." + :prefix "mh-" + :link '(custom-manual "(mh-e)Sending Mail") :group 'mh) -(defgroup mh-identity nil - "Multiple personalities." - :link '(custom-manual "(mh-e)Customizing mh-e") +(defgroup mh-sequences nil + "Sequences." :prefix "mh-" + :link '(custom-manual "(mh-e)Sequences") + :group 'mh) + +(defgroup mh-show nil + "Reading your mail." + :prefix "mh-" + :link '(custom-manual "(mh-e)Reading Mail") + :group 'mh) + +(defgroup mh-speed nil + "The speedbar." + :prefix "mh-speed-" + :link '(custom-manual "(mh-e)Speedbar") + :group 'mh) + +(defgroup mh-toolbar nil + "The toolbar" + :link '(custom-manual "(mh-e)Toolbar") + :prefix "mh-" + :group 'mh) + +(defgroup mh-faces nil + "Faces used in MH-E." + :link '(custom-manual "(mh-e)Top") + :prefix "mh-" + :group 'faces :group 'mh) (defgroup mh-hooks nil "MH-E hooks." - :link '(custom-manual "(mh-e)Customizing mh-e") + :link '(custom-manual "(mh-e)Top") :prefix "mh-" :group 'mh) ;;; Faces -(defgroup mh-speed-faces nil - "Faces used in speedbar." - :link '(custom-manual "(mh-e)Customizing mh-e") - :prefix "mh-" - :group 'mh-faces - :group 'mh-speed) - (defgroup mh-folder-faces nil "Faces used in scan listing." - :link '(custom-manual "(mh-e)Customizing mh-e") + :link '(custom-manual "(mh-e)Organizing") :prefix "mh-" :group 'mh-faces - :group 'mh-folder) + :group 'mh-show) (defgroup mh-index-faces nil - "Faces used in indexed searches." - :link '(custom-manual "(mh-e)Customizing mh-e") + "Faces used in searching." + :link '(custom-manual "(mh-e)Searching") :prefix "mh-" :group 'mh-faces :group 'mh-index) +(defgroup mh-letter-faces nil + "Faces used in message drafts." + :link '(custom-manual "(mh-e)Sending Mail") + :prefix "mh-" + :group 'mh-faces + :group 'mh-letter) + (defgroup mh-show-faces nil "Faces used in message display." - :link '(custom-manual "(mh-e)Customizing mh-e") + :link '(custom-manual "(mh-e)Reading Mail") :prefix "mh-" :group 'mh-faces :group 'mh-show) -(defgroup mh-letter-faces nil - "Faces used when composing messages." - :link '(custom-manual "(mh-e)Customizing mh-e") +(defgroup mh-speed-faces nil + "Faces used in speedbar." + :link '(custom-manual "(mh-e)Speedbar") :prefix "mh-" :group 'mh-faces - :group 'mh-letter) + :group 'mh-speed) -;;; MH-E Customization (:group mh) - -;;; Toolbar configuration (:group 'mh-toolbar) - -(defcustom mh-tool-bar-search-function 'mh-search-folder - "*Function called by the tool-bar search button. -See `mh-search-folder' and `mh-index-search' for details." - :type '(choice (const mh-search-folder) - (const mh-index-search) - (function :tag "Other function")) - :group 'mh-toolbar) - -;; Functions called from the tool bar -(defun mh-tool-bar-search (&optional arg) - "Interactively call `mh-tool-bar-search-function'. -Optional argument ARG is not used." - (interactive "P") - (call-interactively mh-tool-bar-search-function)) - -(defun mh-tool-bar-customize () - "Call `mh-customize' from the toolbar." - (interactive) - (mh-customize t)) - -(defun mh-tool-bar-folder-help () - "Visit \"(mh-e)Top\"." - (interactive) - (Info-goto-node "(mh-e)Top") - (delete-other-windows)) - -(defun mh-tool-bar-letter-help () - "Visit \"(mh-e)Draft Editing\"." - (interactive) - (Info-goto-node "(mh-e)Draft Editing") - (delete-other-windows)) - -(defmacro mh-tool-bar-reply-generator (function recipient folder-buffer-flag) - "Generate FUNCTION that replies to RECIPIENT. -If FOLDER-BUFFER-FLAG is nil then the function generated -When INCLUDE-FLAG is non-nil, include message body being replied to." - `(defun ,function (&optional arg) - ,(format "Reply to \"%s\".\nWhen ARG is non-nil include message in reply." - recipient) - (interactive "P") - ,(if folder-buffer-flag nil '(set-buffer mh-show-folder-buffer)) - (mh-reply (mh-get-msg-num nil) ,recipient arg))) - -(mh-tool-bar-reply-generator mh-tool-bar-reply-from "from" t) -(mh-tool-bar-reply-generator mh-show-tool-bar-reply-from "from" nil) -(mh-tool-bar-reply-generator mh-tool-bar-reply-to "to" t) -(mh-tool-bar-reply-generator mh-show-tool-bar-reply-to "to" nil) -(mh-tool-bar-reply-generator mh-tool-bar-reply-all "all" t) -(mh-tool-bar-reply-generator mh-show-tool-bar-reply-all "all" nil) +;;; Emacs interface to the MH mail system (:group mh) +(eval-when (compile) + (setq mh-variant 'none)) + +(defcustom mh-variant 'autodetect + "*Specifies the variant used by MH-E. + +The default setting of this option is `Auto-detect' which means that MH-E will +automatically choose the first of nmh, MH, or GNU mailutils that it finds in +the directories listed in `mh-path', `mh-sys-path', and `exec-path'. If, for +example, you have both nmh and mailutils installed and `mh-variant-in-use' was +initialized to nmh but you want to use mailutils, then you can set this option +to `mailutils'. + +When this variable is changed, MH-E resets `mh-progs', `mh-lib', +`mh-lib-progs', `mh-flists-present-flag', and `mh-variant-in-use' +accordingly." + :type `(radio + (const :tag "Auto-detect" autodetect) + ,@(mapcar (lambda (x) `(const ,(car x))) (mh-variants))) + :set (lambda (symbol value) + (set-default symbol value) ;Done in mh-variant-set-variant! + (mh-variant-set value)) + :group 'mh) -;; XEmacs has a couple of extra customizations... -(mh-do-in-xemacs - (defcustom mh-xemacs-use-toolbar-flag (if (and (featurep 'toolbar) - (featurep 'xpm) - (device-on-window-system-p)) - t - nil) - "*If non-nil, use toolbar. + -This will default to t if you are in an environment that supports -toolbars and xpm." - :type 'boolean - :group 'mh-toolbar) +;;; Aliases (:group 'mh-alias) - (defcustom mh-xemacs-toolbar-position (if mh-xemacs-use-toolbar-flag - 'default - nil) - "*Where to put the toolbar. +(defcustom 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 may turn +this option off to make case significant which can be used to segregate +completion of your aliases. You might use lowercase for mailing lists and +uppercase for people." + :type 'boolean + :group 'mh-alias) -Valid non-nil values are \"default\", \"top\", \"bottom\", \"left\", -\"right\". These match the four edges of the frame, with \"default\" -meaning \"use the same position as the default-toolbar\". +(defcustom 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 expanded to the full +address in the message draft. By default, this expansion is not performed." + :type 'boolean + :group 'mh-alias) -A nil value means do not use a toolbar. +(defcustom 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 entering +aliases or addresses. The default setting flashes the address associated with +an address in the minibuffer briefly, but does not display a warning if the +alias is not found." + :type '(choice (const :tag "Flash but Don't Warn If No Alias" t) + (const :tag "Flash and Warn If No Alias" 1) + (const :tag "Don't Flash Nor Warn If No Alias" nil)) + :group 'mh-alias) -If this variable is set to anything other than \"default\" and the -default-toolbar has a different positional setting from the value of -this variable, then two toolbars will be displayed. The MH-E toolbar -and the default-toolbar." - :type '(radio (const :tag "Same position as the \"default-toolbar\"" - :value default) - (const :tag "Along the top edge of the frame" - :value top) - (const :tag "Along the bottom edge of the frame" - :value bottom) - (const :tag "Along the left edge of the frame" - :value left) - (const :tag "Along the right edge of the frame" - :value right) - (const :tag "Don't use a toolbar" nil)) - :group 'mh-toolbar)) +(defcustom mh-alias-insert-file nil + "*Filename used to store a new MH-E alias. +The default setting of this option is `Use Aliasfile Profile Component'. This +option can also hold the name of a file or a list a file names. If this option +is set to a list of file names, or the `Aliasfile:' profile component contains +more than one file name, MH-E will prompt for one of them when MH-E adds an +alias." + :type '(choice (const :tag "Use Aliasfile Profile Component" nil) + (file :tag "Alias File") + (repeat :tag "List of Alias Files" file)) + :group 'mh-alias) -(defmacro mh-tool-bar-define (defaults &rest buttons) - "Define a tool bar for MH-E. -DEFAULTS is the list of buttons that are present by default. It is a list of -lists where the sublists are of the following form: +(defcustom 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 your alias +file in other ways, then adding aliases to the `Top' or `Bottom' of your alias +file might be more appropriate." + :type '(choice (const :tag "Alphabetical" sorted) + (const :tag "Top" top) + (const :tag "Bottom" bottom)) + :group 'mh-alias) - (:KEYWORD FUNC1 FUNC2 FUNC3 ...) +(defcustom mh-alias-local-users t + "*If on, local users are added to alias completion. -Here :KEYWORD is one of :folder or :letter. If it is :folder then the default -buttons in the folder and show mode buffers are being specified. If it is -:letter then the default buttons in the letter mode are listed. FUNC1, FUNC2, -FUNC3, ... are the names of the functions that the buttons would execute. +Aliases are created from `/etc/passwd' entries with a user ID larger than +a magical number, typically 200. This can be a handy tool on a machine where +you and co-workers exchange messages. These aliases have the form +`local.first.last' if a real name is present in the password file. +Otherwise, the alias will have the form `local.login'. -Each element of BUTTONS is a list consisting of four mandatory items and one -optional item as follows: +If you're on a system with thousands of users you don't know, and the loading +of local aliases slows MH-E down noticeably, then turn this option off. - (FUNCTION MODES ICON DOC &optional ENABLE-EXPR) +This option also takes a string which is executed to generate the password +file. For example, use \"ypcat passwd\" to obtain the NIS password file." + :type '(choice (boolean) (string)) + :group 'mh-alias) -where, +(defcustom mh-alias-local-users-prefix "local." + "*String prepended to the real names of users from the password file. +This option can also be set to `Use Login'. - FUNCTION is the name of the function that will be executed when the button - is clicked. +For example, consider the following password file entry: - MODES is a list of symbols. List elements must be from `folder', `letter' and - `sequence'. If `folder' is present then the button is available in the - folder and show buffer. If the name of FUNCTION is of the form \"mh-foo\", - where foo is some arbitrary string, then we check if the function - `mh-show-foo' exists. If it exists then that function is used in the show - buffer. Otherwise the original function `mh-foo' is used in the show buffer - as well. Presence of `sequence' is handled similar to the above. The only - difference is that the button is shown only when the folder is narrowed to a - sequence. If `letter' is present in MODES, then the button is available - during draft editing and runs FUNCTION when clicked. + psg:x:1000:1000:Peter S Galbraith,,,:/home/psg:/bin/tcsh - ICON is the icon that is drawn in the button. +The following settings of this option will produce the associated aliases: - DOC is the documentation for the button. It is used in tool-tips and in - providing other help to the user. GNU Emacs uses only the first line of the - string. So the DOC should be formatted such that the first line is useful and - complete without the rest of the string. + \"local.\" local.peter.galbraith + \"\" peter.galbraith + Use Login psg - Optional item ENABLE-EXPR is an arbitrary lisp expression. If it evaluates - to nil, then the button is deactivated, otherwise it is active. If is in't - present then the button is always active." - ;; The following variable names have been carefully chosen to make code - ;; generation easier. Modifying the names should be done carefully. - (let (folder-buttons folder-docs folder-button-setter sequence-button-setter - show-buttons show-button-setter show-seq-button-setter - letter-buttons letter-docs letter-button-setter - folder-defaults letter-defaults - folder-vectors show-vectors letter-vectors) - (dolist (x defaults) - (cond ((eq (car x) :folder) (setq folder-defaults (cdr x))) - ((eq (car x) :letter) (setq letter-defaults (cdr x))))) - (dolist (button buttons) - (unless (and (listp button) - (or (equal (length button) 4) (equal (length button) 5))) - (error "Incorrect MH-E tool-bar button specification: %s" button)) - (let* ((name (nth 0 button)) - (name-str (symbol-name name)) - (icon (nth 2 button)) - (xemacs-icon (mh-do-in-xemacs - (cdr (assoc (intern icon) mh-xemacs-icon-map)))) - (full-doc (nth 3 button)) - (doc (if (string-match "\\(.*\\)\n" full-doc) - (match-string 1 full-doc) - full-doc)) - (enable-expr (or (nth 4 button) t)) - (modes (nth 1 button)) - functions show-sym) - (when (memq 'letter modes) (setq functions `(:letter ,name))) - (when (or (memq 'folder modes) (memq 'sequence modes)) - (setq functions - (append `(,(if (memq 'folder modes) :folder :sequence) ,name) - functions)) - (setq show-sym - (if (string-match "^mh-\\(.*\\)$" name-str) - (intern (concat "mh-show-" (match-string 1 name-str))) - name)) - (setq functions - (append `(,(if (memq 'folder modes) :show :show-seq) - ,(if (fboundp show-sym) show-sym name)) - functions))) - (do ((functions functions (cddr functions))) - ((null functions)) - (let* ((type (car functions)) - (function (cadr functions)) - (type1 (substring (symbol-name type) 1)) - (vector-list (cond ((eq type :show) 'show-vectors) - ((eq type :show-seq) 'show-vectors) - ((eq type :letter) 'letter-vectors) - (t 'folder-vectors))) - (list (cond ((eq type :letter) 'mh-tool-bar-letter-buttons) - (t 'mh-tool-bar-folder-buttons))) - (key (intern (concat "mh-" type1 "toolbar-" name-str))) - (setter (intern (concat type1 "-button-setter"))) - (mbuttons (cond ((eq type :letter) 'letter-buttons) - ((eq type :show) 'show-buttons) - ((eq type :show-seq) 'show-buttons) - (t 'folder-buttons))) - (docs (cond ((eq mbuttons 'letter-buttons) 'letter-docs) - ((eq mbuttons 'folder-buttons) 'folder-docs)))) - (add-to-list vector-list `[,xemacs-icon ,function t ,full-doc]) - (add-to-list - setter `(when (member ',name ,list) - (mh-funcall-if-exists - tool-bar-add-item ,icon ',function ',key - :help ,doc :enable ',enable-expr))) - (add-to-list mbuttons name) - (if docs (add-to-list docs doc)))))) - (setq folder-buttons (nreverse folder-buttons) - letter-buttons (nreverse letter-buttons) - show-buttons (nreverse show-buttons) - letter-docs (nreverse letter-docs) - folder-docs (nreverse folder-docs) - folder-vectors (nreverse folder-vectors) - show-vectors (nreverse show-vectors) - letter-vectors (nreverse letter-vectors)) - (dolist (x folder-defaults) - (unless (memq x folder-buttons) - (error "Folder defaults contains unknown button '%s'" x))) - (dolist (x letter-defaults) - (unless (memq x letter-buttons) - (error "Letter defaults contains unknown button '%s'" x))) - `(eval-when (compile load eval) - (defvar mh-folder-tool-bar-map nil) - (defvar mh-folder-seq-tool-bar-map nil) - (defvar mh-show-tool-bar-map nil) - (defvar mh-show-seq-tool-bar-map nil) - (defvar mh-letter-tool-bar-map nil) - ;; GNU Emacs tool bar specific code - (mh-do-in-gnu-emacs - ;; Custom setter functions - (defun mh-tool-bar-folder-buttons-set (symbol value) - "Construct toolbar for `mh-folder-mode' and `mh-show-mode'." - (set-default symbol value) - (setq mh-folder-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse folder-button-setter) - tool-bar-map)) - (setq mh-show-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse show-button-setter) - tool-bar-map)) - (setq mh-show-seq-tool-bar-map - (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map))) - ,@(nreverse show-seq-button-setter) - tool-bar-map)) - (setq mh-folder-seq-tool-bar-map - (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) - ,@(nreverse sequence-button-setter) - tool-bar-map))) - (defun mh-tool-bar-letter-buttons-set (symbol value) - "Construct toolbar for `mh-letter-mode'." - (set-default symbol value) - (setq mh-letter-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - ,@(nreverse letter-button-setter) - tool-bar-map)))) - ;; XEmacs specific code - (mh-do-in-xemacs - (defvar mh-toolbar-folder-vector-map - ',(loop for button in folder-buttons - for vector in folder-vectors - collect (cons button vector))) - (defvar mh-toolbar-show-vector-map - ',(loop for button in show-buttons - for vector in show-vectors - collect (cons button vector))) - (defvar mh-toolbar-letter-vector-map - ',(loop for button in letter-buttons - for vector in letter-vectors - collect (cons button vector))) - (defvar mh-toolbar-folder-buttons nil) - (defvar mh-toolbar-show-buttons nil) - (defvar mh-toolbar-letter-buttons nil) - ;; Custom setter functions - (defun mh-tool-bar-letter-buttons-set (symbol value) - (set-default symbol value) - (setq mh-toolbar-letter-buttons - (loop for b in value - collect (cdr (assoc b mh-toolbar-letter-vector-map))))) - (defun mh-tool-bar-folder-buttons-set (symbol value) - (set-default symbol value) - (setq mh-toolbar-folder-buttons - (loop for b in value - collect (cdr (assoc b mh-toolbar-folder-vector-map)))) - (setq mh-toolbar-show-buttons - (loop for b in value - collect (cdr (assoc b mh-toolbar-show-vector-map))))) - ;; Initialize toolbar - (defun mh-toolbar-init (mode) - "Install toolbar in MODE." - (let ((toolbar (cond ((eq mode :folder) mh-toolbar-folder-buttons) - ((eq mode :letter) mh-toolbar-letter-buttons) - ((eq mode :show) mh-toolbar-show-buttons))) - (height 37) - (width 40) - (buffer (current-buffer))) - (when (and mh-xemacs-toolbar-position mh-xemacs-use-toolbar-flag) - (cond - ((eq mh-xemacs-toolbar-position 'top) - (set-specifier top-toolbar toolbar buffer) - (set-specifier top-toolbar-visible-p t) - (set-specifier top-toolbar-height height)) - ((eq mh-xemacs-toolbar-position 'bottom) - (set-specifier bottom-toolbar toolbar buffer) - (set-specifier bottom-toolbar-visible-p t) - (set-specifier bottom-toolbar-height height)) - ((eq mh-xemacs-toolbar-position 'left) - (set-specifier left-toolbar toolbar buffer) - (set-specifier left-toolbar-visible-p t) - (set-specifier left-toolbar-width width)) - ((eq mh-xemacs-toolbar-position 'right) - (set-specifier right-toolbar toolbar buffer) - (set-specifier right-toolbar-visible-p t) - (set-specifier right-toolbar-width width)) - (t (set-specifier default-toolbar toolbar buffer))))))) - ;; Declare customizable toolbars - (custom-declare-variable - 'mh-tool-bar-folder-buttons - '(list ,@(mapcar (lambda (x) `(quote ,x)) folder-defaults)) - "Choose buttons to include in MH-E folder/show toolbar." - :group 'mh-toolbar :set 'mh-tool-bar-folder-buttons-set - :type '(set ,@(loop for x in folder-buttons - for y in folder-docs - collect `(const :tag ,y ,x)))) - (custom-declare-variable - 'mh-tool-bar-letter-buttons - '(list ,@(mapcar (lambda (x) `(quote ,x)) letter-defaults)) - "Choose buttons to include in MH-E letter toolbar." - :group 'mh-toolbar :set 'mh-tool-bar-letter-buttons-set - :type '(set ,@(loop for x in letter-buttons - for y in letter-docs - collect `(const :tag ,y ,x))))))) +This option has no effect if variable `mh-alias-local-users' is turned off." + :type '(choice (const :tag "Use Login" nil) + (string)) + :group 'mh-alias) -(mh-tool-bar-define - ((:folder mh-inc-folder mh-mime-save-parts mh-previous-undeleted-msg - mh-page-msg mh-next-undeleted-msg mh-delete-msg mh-refile-msg - mh-undo mh-execute-commands mh-toggle-tick mh-reply - mh-alias-grab-from-field mh-send mh-rescan-folder - mh-tool-bar-search mh-visit-folder - mh-tool-bar-customize mh-tool-bar-folder-help mh-widen) - (:letter mh-send-letter mh-compose-insertion ispell-message save-buffer - undo kill-region menu-bar-kill-ring-save yank mh-fully-kill-draft - mh-tool-bar-customize mh-tool-bar-letter-help)) - ;; Folder/Show buffer buttons - (mh-inc-folder (folder) "mail" - "Incorporate new mail in Inbox -This button runs `mh-inc-folder' which drags any -new mail into your Inbox folder.") - (mh-mime-save-parts (folder) "attach" - "Save MIME parts from this message -This button runs `mh-mime-save-parts' which saves a message's -different parts into separate files.") - (mh-previous-undeleted-msg (folder) "left_arrow" - "Go to the previous undeleted message -This button runs `mh-previous-undeleted-msg'") - (mh-page-msg (folder) "page-down" - "Page the current message forwards\nThis button runs `mh-page-msg'") - (mh-next-undeleted-msg (folder) "right_arrow" - "Go to the next undeleted message\nThe button runs `mh-next-undeleted-msg'") - (mh-delete-msg (folder) "close" - "Mark this message for deletion\nThis button runs `mh-delete-msg'") - (mh-refile-msg (folder) "refile" - "Refile this message\nThis button runs `mh-refile-msg'") - (mh-undo (folder) "undo" "Undo last operation\nThis button runs `undo'") - (mh-execute-commands (folder) "execute" - "Perform moves and deletes\nThis button runs `mh-execute-commands'") - (mh-toggle-tick (folder) "highlight" - "Toggle tick mark\nThis button runs `mh-toggle-tick'") - (mh-toggle-showing (folder) "show" - "Toggle showing message\nThis button runs `mh-toggle-showing'") - (mh-tool-bar-reply-from (folder) "reply-from" "Reply to \"from\"") - (mh-tool-bar-reply-to (folder) "reply-to" "Reply to \"to\"") - (mh-tool-bar-reply-all (folder) "reply-all" "Reply to \"all\"") - (mh-reply (folder) "mail/reply2" - "Reply to this message\nThis button runs `mh-reply'") - (mh-alias-grab-from-field (folder) "alias" - "Grab From alias\nThis button runs `mh-alias-grab-from-field'" - (mh-alias-from-has-no-alias-p)) - (mh-send (folder) "mail_compose" - "Compose new message\nThis button runs `mh-send'") - (mh-rescan-folder (folder) "rescan" - "Rescan this folder\nThis button runs `mh-rescan-folder'") - (mh-pack-folder (folder) "repack" - "Repack this folder\nThis button runs `mh-pack-folder'") - (mh-tool-bar-search (folder) "search" - "Search\nThis button runs `mh-tool-bar-search-function'") - (mh-visit-folder (folder) "fld_open" - "Visit other folder\nThis button runs `mh-visit-folder'") - ;; Letter buffer buttons - (mh-send-letter (letter) "mail_send" "Send this letter") - (mh-compose-insertion (letter) "attach" "Insert attachment") - (ispell-message (letter) "spell" "Check spelling") - (save-buffer (letter) "save" "Save current buffer to its file") - (undo (letter) "undo" "Undo last operation") - (kill-region (letter) "cut" - "Cut (kill) text in region between mark and current position") - (menu-bar-kill-ring-save (letter) "copy" - "Copy text in region between mark and current position") - (yank (letter) "paste" "Paste (yank) text cut or copied earlier") - (mh-fully-kill-draft (letter) "close" "Kill this draft") - ;; Common buttons - (mh-tool-bar-customize (folder letter) "preferences" "MH-E Preferences") - (mh-tool-bar-folder-help (folder) "help" - "Help! (general help)\nThis button runs `Info-goto-node'") - (mh-tool-bar-letter-help (letter) "help" - "Help! (general help)\nThis button runs `Info-goto-node'") - ;; Folder narrowed to sequence buttons - (mh-widen (sequence) "widen" - "Widen from the sequence\nThis button runs `mh-widen'")) +(defcustom 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 to separate +different values within the so-called gecos field. This is a fairly common +usage. However, in the rare case that the 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) -;;; Speedbar and folder configuration (:group 'mh-speed) - -(defcustom 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 in it exceed -this value, then confirmation is needed when it is visited. Even when -`mh-show-threads-flag' is non-nil, the folder 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-speed) - -(defcustom mh-speed-flists-interval 60 - "Time between calls to flists in seconds. -If 0, flists is not called repeatedly." - :type 'integer - :group 'mh-speed) +;;; Organizing Your Mail with Folders (:group 'mh-folder) -(defcustom mh-speed-run-flists-flag t - "Non-nil means flists is used. -If non-nil, flists is executed every `mh-speed-flists-interval' seconds to -update the display of the number of unseen and total messages in each folder. -If resources are limited, this can be set to nil and the speedbar display can -be updated manually with the \\[mh-speed-flists] command." +(defcustom 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-speed) + :group 'mh-folder) -;;; Options for controlling scan listing (:group 'mh-folder) - -(defcustom mh-adaptive-cmd-note-flag t - "*Non-nil means that the message number width is determined dynamically. -This is done once when a folder is first opened by running scan on the last -message of the folder. The message number for the last message is extracted -and its width calculated. This width is used when calling `mh-set-cmd-note'. +;;; Folder Selection (:group 'mh-folder-selection) -If you prefer fixed-width message numbers, set this variable to nil and call -`mh-set-cmd-note' with the width specified by the scan format in -`mh-scan-format-file'. For example, the default width is 4, so you would use -\"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil." - :type 'boolean - :group 'mh-folder) +(defcustom mh-default-folder-for-message-function nil + "Function to select a default folder for refiling or `Fcc'. +The current buffer is set to the message being refiled with point at the start +of the message. This function should return the default folder as a string +with a leading `+' 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) (defcustom mh-default-folder-list nil - "*Alist of addresses and folders. -When refiling messages, these folders are the default that is provided if the -sender (or recipient if the Check Recipient checkbox has been selected) has -the associated address, a regexp. The first entry to match will be used, so -order them according to the wanted priority. You do not need to list your -aliases here as that lookup is already performed. + "*List of addresses and folders. +The folder name associated with the first address found in this list is used +as the default for `mh-refile-msg' and similar functions. Each element in this +list contains a `Check Recipient' item. If this item is turned on, then the +address is checked against the recipient instead of the sender. This is useful +for mailing lists. See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more information." :type '(repeat (list (regexp :tag "Address") (string :tag "Folder") (boolean :tag "Check Recipient"))) - :group 'mh-folder) + :group 'mh-folder-selection) (defcustom mh-default-folder-must-exist-flag t "*Non-nil means guessed folder name must exist to be used. -If this variable is t, then the guessed name is only used if the folder -already exists\; if the folder doesn't exist, then the last folder name used -is suggested. This is useful if you get mail from various people for whom you -have an alias, but file them all in the same project folder. +If the derived folder does not exist, and this option is on, then the last +folder name used is suggested. This is useful if you get mail from various +people for whom you have an alias, but file them all in the same project +folder. + See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more information." :type 'boolean - :group 'mh-folder) + :group 'mh-folder-selection) (defcustom mh-default-folder-prefix "" - "*Prefix used for guessed folder names. -This can be used to put folders associated with your aliases in a sub-folder -so as to not clutter your mail directory. + "*Prefix used for folder names generated from aliases. +The prefix is used to prevent clutter in your mail directory. + See `mh-prompt-for-refile-folder' and `mh-folder-from-address' for more information." :type 'string - :group 'mh-folder) - -(defcustom mh-inc-prog "inc" - "*Program to run to incorporate new mail into a folder. -Normally \"inc\". This file is searched for relative to -the `mh-progs' directory unless it is an absolute pathname." - :type 'string - :group 'mh-folder) - -(defcustom mh-inc-spool-list nil - "*Alist of alternate spool files, corresponding folders and keybindings. -Here's an example. Suppose you have subscribed to the MH-E devel mailing -list. You could filter its mail into a separate spool file named -~/mail/mh-e using Procmail and a .procmailrc entry like: - -MAILDIR=$HOME/mail #you'd better make sure it exists -:0: -* ^From mh-e-devel-admin@lists.sourceforge.net -mh-e - -If you wanted to incorporate that spool file into an MH folder called -mh-e by pressing \"I m\" in folder-mode or by `M-x mh-inc-spool-mh-e', -you would setup `mh-inc-spool-list' with an entry: - - Spool file: ~/mail/mh-e - Folder: mh-e - Key binding: m - -Then, you could also install `xbuffy' and configure an extra mailbox like so: - -box ~/mail/mh-e - title mh-e - origMode - polltime 10 - headertime 0 - command gnudoit -q '(mh-inc-spool-mh-e)' - -Note that the entry above uses the gnuserv package to communicate the -command `mh-inc-spool-mh-e' to Emacs. It will incorporate the spool file -when clicking the xbuffy box with the middle mouse button." - :type '(repeat (list (file :tag "Spool file") - (string :tag "Folder") - (character :tag "Key binding"))) - :set 'mh-inc-spool-list-set - :group 'mh-folder) + :group 'mh-folder-selection) -(defcustom mh-interpret-number-as-range-flag t - "Non-nil means interpret a number as a range. -If the variable is non-nil, and you use an integer, N, when asked for a -range to scan, then MH-E uses the range \"last:N\"." - :type 'boolean - :group 'mh-folder) - -(defcustom mh-lpr-command-format "lpr -J '%s'" - "*Format for Unix command that prints a message. -The string should be a Unix command line, with the string '%s' where -the job's name (folder and message number) should appear. The formatted -message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'." - :type 'string - :group 'mh-folder) + -(defcustom mh-mime-save-parts-default-directory t - "Default directory to use for `mh-mime-save-parts'. -If nil, prompt and set for next time the command is used during same session. -If t, prompt always" - :type '(choice (const :tag "Prompt the first time" nil) - (const :tag "Prompt always" t) - directory) - :group 'mh-folder) +;;; Identities (:group 'mh-identity) -(defcustom mh-print-background-flag nil - "*Non-nil means messages should be printed in the background. -WARNING: do not delete the messages until printing is finished; -otherwise, your output may be truncated." - :type 'boolean - :group 'mh-folder) +(defcustom mh-identity-list nil + "*List of identities. + +Each element consists of an identity label, and a collection of header fields +and a signature to insert if the identity is selected (see +`mh-identity-default', `mh-insert-identity' and the `Identity' menu in a +MH-Letter buffer). The `Value Menu' contains the common header fields `From' +and `Organization'. Other header fields may be added using the `Other Field' +menu item. The `Signature' menu item is used to insert a signature with +`mh-insert-signature'. The `GPG Key ID' menu item is used to specify a +different key to sign or encrypt messages." + :type '(repeat (list :tag "" + (string :tag "Label") + (repeat :tag "Add at least one item below" + (choice + (cons :tag "From Field" + (const "From") + (string :tag "Value")) + (cons :tag "Organization Field" + (const "Organization") + (string :tag "Value")) + (cons :tag "Other Field" + (string :tag "Field") + (string :tag "Value")) + (cons :tag "Attribution Verb" + (const ":attribution-verb") + (string :tag "Value")) + (cons :tag "Signature" + (const :tag "Signature" + ":signature") + (choice + (const :tag "mh-signature-file-name" + nil) + (file) + (function))) + (cons :tag "GPG Key ID" + (const :tag "GPG Key ID" + ":pgg-default-user-id") + (string :tag "Value")))))) + :set 'mh-identity-list-set + :group 'mh-identity) -(defcustom mh-recenter-summary-flag nil - "*Non-nil means to recenter the summary window. -Recenter the summary window when the show window is toggled off if non-nil." - :type 'boolean - :group 'mh-folder) +(defcustom mh-auto-fields-list nil + "List of recipients for which header lines are automatically inserted. +Each element consists of the recipient, which is a regular expression, and a +collection of header fields and identities to insert if the message is sent to +this recipient. The `Value Menu' contains the common header fields `Fcc' and +`Mail-Followup-To'. Other header fields may be added using the `Other Field' +menu item. The `Identity' menu item is used to insert entire identities with +`mh-insert-identity'." + :type `(repeat + (list :tag "" + (string :tag "Recipient") + (repeat :tag "Add at least one item below" + (choice + (cons :tag "Identity" + (const ":identity") + ,(append + '(radio) + (mapcar + (function (lambda (arg) `(const ,arg))) + (mapcar 'car mh-identity-list)))) + (cons :tag "Fcc Field" + (const "fcc") + (string :tag "Value")) + (cons :tag "Mail-Followup-To Field" + (const "Mail-Followup-To") + (string :tag "Value")) + (cons :tag "Other Field" + (string :tag "Field") + (string :tag "Value")))))) + :group 'mh-identity) -(defcustom mh-recursive-folders-flag nil - "*Non-nil means that commands which operate on folders do so recursively." +(defcustom 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-folder) + :group 'mh-identity) -;;; If `mh-unpropagated-sequences' becomes a defcustom, add the following tot -;;; he docstring: "Additional sequences that should not to be preserved can be -;;; specified by setting `mh-unpropagated-sequences' appropriately." XXX +(defcustom mh-identity-default nil + "Default identity to use when `mh-letter-mode' is called." + :type (append + '(radio) + (cons '(const :tag "None" nil) + (mapcar (function (lambda (arg) `(const ,arg))) + (mapcar 'car mh-identity-list)))) + :group 'mh-identity) -(defcustom mh-refile-preserves-sequences-flag t - "*Non-nil means that sequences are preserved when messages are refiled. -If this variable is non-nil and a message belonging to a sequence other than -cur or Previous-Sequence (see mh-profile 5) is refiled then it is put in the -same sequence in the destination folder." - :type 'boolean - :group 'mh-folder) +(defcustom mh-identity-handlers + '((":default" . mh-identity-handler-bottom) + ("from" . mh-identity-handler-top) + (":attribution-verb" . mh-identity-handler-attribution-verb) + (":signature" . mh-identity-handler-signature) + (":pgg-default-user-id" . mh-identity-handler-gpg-identity)) + "Handler functions for fields in `mh-identity-list'. +This is an alist of fields (strings) and handlers (functions). Strings are +lowercase. Use \":signature\" for Signature and \":pgg-default-user-id\" for +GPG Key ID. The function associated with the string \":default\" is used if no +other functions are appropriate." + :type '(repeat (cons (string :tag "Field") function)) + :group 'mh-identity) -(defcustom mh-scan-format-file t - "Specifies the format file to pass to the scan program. -If t, the format string will be taken from the either `mh-scan-format-mh' -or `mh-scan-format-nmh' depending on whether MH or nmh is in use. -If nil, the default scan output will be used. + -If you customize the scan format, you may need to modify a few variables -containing regexps that MH-E uses to identify specific portions of the output. -Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You -may also have to call `mh-set-cmd-note' with the width of your message -numbers. See also `mh-adaptive-cmd-note-flag'." - :type '(choice (const :tag "Use MH-E scan format" t) - (const :tag "Use default scan format" nil) - (file :tag "Specify a scan format file")) - :group 'mh-folder) +;;; Incorporating Your Mail (:group 'mh-inc) -(defcustom mh-scan-prog "scan" - "*Program to run to generate one-line-per-message listing of a folder. -Normally \"scan\" or a file name linked to scan. This file is searched -for relative to the `mh-progs' directory unless it is an absolute pathname." +(defcustom mh-inc-prog "inc" + "*Program to run to incorporate new mail into a folder. +Normally \"inc\". This program is relative to the `mh-progs' directory unless +it is an absolute pathname." :type 'string - :group 'mh-folder) -(make-variable-buffer-local 'mh-scan-prog) - -(defcustom mh-show-threads-flag nil - "Non-nil means new folders start in threaded mode. -Threading large number of messages can be time consuming. So if the flag is -non-nil then threading will be done only if the number of messages being -threaded is less than `mh-large-folder'." - :type 'boolean - :group 'mh-folder) + :group 'mh-inc) -(defcustom mh-store-default-directory nil - "*Last directory used by \\[mh-store-msg]; default for next store. -A directory name string, or nil to use current directory." - :type '(choice (const :tag "Current" nil) - directory) - :group 'mh-folder) - -(defcustom mh-tick-seq 'tick - "The name of the MH tick sequence." - :type '(choice (const :tag "Disable ticking" nil) - symbol) - :group 'mh-folder) - -(defcustom mh-update-sequences-after-mh-show-flag t - "*Non-nil means `mh-update-sequence' is called from `mh-show-mode'. -If set, `mh-update-sequence' is run every time a message is shown, telling -MH or nmh that this is your current message. It's useful, for example, to -display MIME content using \"M-! mhshow RET\"" - :type 'boolean - :group 'mh-folder) +(defcustom mh-inc-spool-list nil + "*Alist of alternate spool files, corresponding folders and keybindings. +This option will be described by example. + +Suppose you have subscribed to the mh-e-devel mailing list and you use +procmail to filter its mail into `~/mail/mh-e' with the following +`.procmailrc' recipe: + + MAILDIR=$HOME/mail + :0: + * ^From mh-e-devel-admin@lists.sourceforge.net + mh-e + +If you wanted to incorporate that spool file into an MH folder called mh-e +with the \"I m\" or \\[mh-inc-spool-mh-e] commands, you would use the +following: + + Spool File: ~/mail/mh-e + Folder: mh-e + Key Binding: m + +Then, you could also install `xbuffy' and configure an extra mailbox using the +gnuserv package to run the `mh-inc-spool-mh-e' command in Emacs: + + box ~/mail/mh-e + title mh-e + origMode + polltime 10 + headertime 0 + command gnudoit -q '(mh-inc-spool-mh-e)' + +To incorporate the spool file, click the xbuffy box with the middle mouse +button." + :type '(repeat (list (file :tag "Spool File") + (string :tag "Folder") + (character :tag "Key Binding"))) + :set 'mh-inc-spool-list-set + :group 'mh-inc) -;;; Indexed searching (:group 'mh-index) +;;; Searching (:group 'mh-index) (defcustom mh-index-new-messages-folders t - "Folders searched for `mh-unseen-seq'. -If t, then `mh-inbox' is searched. If nil, all the top level folders are -searched. Otherwise the list of folders specified as strings are searched. + "Folders searched for the `unseen' sequence. +This option can be set to `Inbox' to search the `+inbox' folder or `All' to +search all of the top level folders. Otherwise, list the folders that should +be searched with the `Choose Folders' menu item. + See also `mh-recursive-folders-flag'." :group 'mh-index :type '(choice (const :tag "Inbox" t) (const :tag "All" nil) - (repeat :tag "Choose folders" (string :tag "Folder")))) + (repeat :tag "Choose Folders" (string :tag "Folder")))) (defcustom mh-index-program nil "Indexing program that MH-E shall use. -The possible choices are swish++, swish-e, mairix, namazu, glimpse, pick and -grep. By default this variable is nil which means that the programs are tried -in order and the first one found is used. +The default setting of this option is `Auto-detect' which means that MH-E will +automatically choose one of swish++, swish-e, mairix, namazu, pick and grep in +that order. If, for example, you have both swish++ and mairix installed and +you want to use mairix, then you can set this option to `mairix'. More information about setting up an indexing program to use with MH-E can be found in the documentation of `mh-index-search'." @@ -850,33 +627,34 @@ found in the documentation of `mh-index-search'." (const :tag "swish-e" swish) (const :tag "mairix" mairix) (const :tag "namazu" namazu) - (const :tag "glimpse" glimpse) (const :tag "pick" pick) (const :tag "grep" grep)) :group 'mh-index) (defcustom mh-index-ticked-messages-folders t "Folders searched for `mh-tick-seq'. -If t, then `mh-inbox' is searched. If nil, all the top level folders are -searched. Otherwise the list of folders specified as strings are searched. +This option can be set to `Inbox' to search the `+inbox' folder or `All' to +search all of the top level folders. Otherwise, list the folders that should +be searched with the `Choose Folders' menu item. + See also `mh-recursive-folders-flag'." :group 'mh-index :type '(choice (const :tag "Inbox" t) (const :tag "All" nil) - (repeat :tag "Choose folders" (string :tag "Folder")))) + (repeat :tag "Choose Folders" (string :tag "Folder")))) -;;; Spam Handling (:group 'mh-junk) +;;; Dealing with Junk Mail (:group 'mh-junk) ;; Spam fighting program chosen (defvar mh-junk-choice nil) ;; Available spam filter interfaces (defvar mh-junk-function-alist - '((bogofilter mh-bogofilter-blacklist mh-bogofilter-whitelist) - (spamprobe mh-spamprobe-blacklist mh-spamprobe-whitelist) - (spamassassin mh-spamassassin-blacklist mh-spamassassin-whitelist)) + '((spamassassin mh-spamassassin-blacklist mh-spamassassin-whitelist) + (bogofilter mh-bogofilter-blacklist mh-bogofilter-whitelist) + (spamprobe mh-spamprobe-blacklist mh-spamprobe-whitelist)) "Available choices of spam programs to use. This is an alist. For each element there are functions that blacklist a message as spam and whitelist a message incorrectly classified as spam.") @@ -894,28 +672,348 @@ bound to the new value of `mh-junk-program'. The function sets the variable finally return (car element))))) ;; User customizable variables -(defcustom mh-junk-mail-folder nil - "Folder to put spam mail in. -If nil then the spam is deleted." - :type '(choice (const :tag "Delete spam" nil) - (string :tag "Spam folder")) +(defcustom mh-junk-disposition nil + "Disposition of junk mail." + :type '(choice (const :tag "Delete Spam" nil) + (string :tag "Spam Folder")) :group 'mh-junk) (defcustom mh-junk-program nil - "Spam program that MH-E shall use. -The possible choices are bogofilter, spamprobe, and spamassassin. By default -this variable is nil which means that the programs are tried in order and the -first one found is used." - :type '(choice (const :tag "auto-detect" nil) - (const :tag "bogofilter" bogofilter) - (const :tag "spamprobe" spamprobe) - (const :tag "spamassassin" spamassassin)) + "Spam program that MH-E should use. +The default setting of this option is `Auto-detect' which means that MH-E will +automatically choose one of SpamAssassin, Bogofilter, or SpamProbe in that +order. If, for example, you have both SpamAssassin and Bogofilter installed +and you want to use BogoFilter, then you can set this option to `Bogofilter'." + :type '(choice (const :tag "Auto-detect" nil) + (const :tag "SpamAssassin" spamassassin) + (const :tag "Bogofilter" bogofilter) + (const :tag "SpamProbe" spamprobe)) :set 'mh-junk-choose :group 'mh-junk) +(defcustom mh-junk-background nil + "If on, spam programs are run in background. +By default, the programs are run in the foreground, but this can be slow when +junking large numbers of messages. If you have enough memory or don't junk +that many messages at the same time, you might try turning on this option." + :type '(choice (const :tag "Off" nil) + (const :tag "On" 0)) + :group 'mh-junk) + + + +;;; Editing a Draft (:group 'mh-letter) + +(defcustom mh-mml-method-default (if mh-gnus-pgp-support-flag "pgpmime" "none") + "Default method to use in security directives." + :type '(choice (const :tag "PGP (MIME)" "pgpmime") + (const :tag "PGP" "pgp") + (const :tag "S/MIME" "smime") + (const :tag "None" "none")) + :group 'mh-letter) + +(defcustom mh-compose-forward-as-mime-flag t + "Non-nil means that messages are forwarded as a MIME part." + :type 'boolean + :group 'mh-letter) + +(defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn) + "Type of MIME message directives in messages. + +By default, this option is set to `Gnus' if it is supported. This option can +also be set manually to `mhn' if mhn directives are preferred." + :type '(choice (const :tag "Gnus" gnus) + (const :tag "mhn" mhn)) + :group 'mh-letter) + +(defcustom 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) + +(defcustom mh-compose-space-does-completion-flag nil + "*Non-nil means that <SPC> does completion in message header." + :type 'boolean + :group 'mh-letter) + +(defcustom mh-delete-yanked-msg-window-flag nil + "*Non-nil means delete any window displaying the message. +If this option is on, yanking the current message into a draft letter with +\\<mh-letter-mode-map>\\[mh-yank-cur-msg] deletes any windows displaying the +message." + :type 'boolean + :group 'mh-letter) + +(defcustom 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]." + :type '(choice (const "wrote:") + (const "a écrit:") + (const "schrieb:") + (string :tag "Custom String")) + :group 'mh-letter) + +(defcustom mh-ins-buf-prefix "> " + "*String to put before each non-blank line of a yanked or inserted message. +Used when the message is inserted into an outgoing letter +by \\<mh-letter-mode-map>\\[mh-insert-letter] or \\[mh-yank-cur-msg]." + :type 'string + :group 'mh-letter) + +(defcustom mh-insert-x-mailer-flag t + "*Non-nil means append an X-Mailer field to the header." + :type 'boolean + :group 'mh-letter) + +(defcustom mh-letter-complete-function 'ispell-complete-word + "*Function to call when completing outside of address or folder fields. +By default, this is set to `ispell-complete-word'." + :type '(choice function (const nil)) + :group 'mh-letter) + +(defcustom mh-letter-fill-column 72 + "*Fill column to use in `mh-letter-mode'. +This is usually less than in other text modes because email messages get +quoted by some prefix (sometimes many times) when they are replied to, +and it's best to avoid quoted lines that span more than 80 columns." + :type 'integer + :group 'mh-letter) + +(defcustom mh-reply-show-message-flag t + "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply]. + +The setting of this variable determines whether the MH `show-buffer' is +displayed with the current message when using `mh-reply' without a prefix +argument. Set it to nil if you already include the message automatically +in your draft using + repl: -filter repl.filter +in your ~/.mh_profile file." + :type 'boolean + :group 'mh-letter) + +(defcustom mh-signature-file-name "~/.signature" + "*Source of user's signature. + +By default, the text of your signature is taken from the file `~/.signature'. +You can read from other files by changing this option. This file may contain a +vCard in which case an attachment is added with the vCard. + +This option may also be a symbol, in which case that function is called. You +may not want a signature separator to be added for you; instead you may want +to insert one yourself. Variables that you may find useful to do this include +`mh-signature-separator' (when inserting a signature separator) and +`mh-signature-separator-regexp' (for finding said separator). The function +`mh-signature-separator-p', which reports t if the buffer contains a +separator, may be useful as well. + +The signature is inserted into your message with the command +\\<mh-letter-mode-map>\\[mh-insert-signature] or with the `mh-identity-list' +option." + :type 'file + :group 'mh-letter) + +(defcustom 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 mail user +agents, including MH-E, use the separator to present the signature +differently, and to suppress the signature when replying or yanking a letter +into a draft." + :type 'boolean + :group 'mh-letter) + +(defcustom 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:' or +`X-Image-URL:' then the contents are added to the message header verbatim. +Otherwise it is assumed that the file contains the value of the `X-Face:' +header field. + +The `X-Face:' header field, which is a low-resolution, black and white image, +can be generated using the `compface' command, which can be obtained from +ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z. The \"Online +X-Face Convertor\" at http://www.dairiki.org/xface/ is a useful resource for +quick conversion of images into `X-Face:' header fields. + +Use the `make-face' script (http://quimby.gnus.org/circus/face/make-face) to +convert a JPEG image to the higher resolution, color, `Face:' header field. + +The URL of any image can be used for the `X-Image-URL:' field and no +processing of the image is required. + +To prevent the setting of any of these header fields, either set +`mh-x-face-file' to nil, or simply ensure that the file defined by this option +doesn't exist." + :type 'file + :group 'mh-letter) + +(defcustom mh-yank-from-start-of-msg 'attribution + "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. +If t, include the entire message, with full headers. This is historically +here for use with supercite, but is now deprecated in favor of the setting +`supercite' below. + +If the symbol `body', then yank the message minus the header. + +If the symbol `supercite', include the entire message, with full headers. +This also causes the invocation of `sc-cite-original' without the setting +of `mail-citation-hook', now deprecated practice. + +If the symbol `autosupercite', do as for `supercite' automatically when +show buffer matches the message being replied-to. When this option is used, +the -noformat switch is passed to the repl program to override a -filter or +-format switch. + +If the symbol `attribution', then yank the message minus the header and add +a simple attribution line at the top. + +If the symbol `autoattrib', do as for `attribution' automatically when show +buffer matches the message being replied-to. You can make sure this is +always the case by setting `mh-reply-show-message-flag' to t (which is the +default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such +that the show window is never displayed. When the `autoattrib' option is +used, the -noformat switch is passed to the repl program to override a +-filter or -format switch. + +If nil, yank only the portion of the message following the point. + +If the show buffer has a region, this variable is ignored unless its value is +one of `attribution' or `autoattrib' in which case the attribution is added +to the yanked region." + :type '(choice (const :tag "Below point" nil) + (const :tag "Without header" body) + (const :tag "Invoke supercite" supercite) + (const :tag "Invoke supercite, automatically" autosupercite) + (const :tag "Without header, with attribution" attribution) + (const :tag "Without header, with attribution, automatically" + autoattrib) + (const :tag "Entire message with headers" t)) + :group 'mh-letter) + + + +;;; Ranges (:group 'mh-ranges) + +(defcustom mh-interpret-number-as-range-flag t + "Non-nil means interpret a number as a range. +If the variable is non-nil, and you use an integer, N, when asked for a +range to scan, then MH-E uses the range \"last:N\"." + :type 'boolean + :group 'mh-ranges) + + + +;;; Scan Line Formats (:group 'mh-scan-line-formats) + +(defcustom mh-adaptive-cmd-note-flag t + "*Non-nil means that the message number width is determined dynamically. +This is done once when a folder is first opened by running scan on the last +message of the folder. The message number for the last message is extracted +and its width calculated. This width is used when calling `mh-set-cmd-note'. + +If you prefer fixed-width message numbers, set this variable to nil and call +`mh-set-cmd-note' with the width specified by the scan format in +`mh-scan-format-file'. For example, the default width is 4, so you would use +\"(mh-set-cmd-note 4)\" if `mh-scan-format-file' were nil." + :type 'boolean + :group 'mh-scan-line-formats) + +(defcustom mh-scan-format-file t + "Specifies the format file to pass to the scan program. +If t, the format string will be taken from the either `mh-scan-format-mh' +or `mh-scan-format-nmh' depending on whether MH or nmh is in use. +If nil, the default scan output will be used. + +If you customize the scan format, you may need to modify a few variables +containing regexps that MH-E uses to identify specific portions of the output. +Use `M-x apropos RET mh-scan.*regexp' to obtain a list of these variables. You +may also have to call `mh-set-cmd-note' with the width of your message +numbers. See also `mh-adaptive-cmd-note-flag'." + :type '(choice (const :tag "Use MH-E scan Format" t) + (const :tag "Use Default scan Format" nil) + (file :tag "Specify a scan Format File")) + :group 'mh-scan-line-formats) + +(defcustom mh-scan-prog "scan" + "*Program to run to generate one-line-per-message listing of a folder. +Normally \"scan\" or a file name linked to scan. This file is searched +for relative to the `mh-progs' directory unless it is an absolute pathname." + :type 'string + :group 'mh-scan-line-formats) +(make-variable-buffer-local 'mh-scan-prog) + -;;; Message display (:group 'mh-show) +;;; Sending Mail (:group 'mh-sending-mail) + +(defcustom mh-compose-letter-function nil + "Invoked when setting up a letter draft. +It is passed three arguments: TO recipients, SUBJECT, and CC recipients." + :type '(choice (const nil) function) + :group 'mh-sending-mail) + +(defcustom mh-compose-prompt-flag nil + "*Non-nil means prompt for header fields when composing a new draft." + :type 'boolean + :group 'mh-sending-mail) + +(defcustom mh-forward-subject-format "%s: %s" + "*Format to generate the Subject: line contents for a forwarded message. +The two string arguments to the format are the sender of the original +message and the original subject line." + :type 'string + :group 'mh-sending-mail) + +(defcustom mh-reply-default-reply-to nil + "*Sets the person or persons to whom a reply will be sent. +If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this +value and it should be one of \"from\", \"to\", \"cc\", or \"all\". +The values \"cc\" and \"all\" do the same thing." + :type '(choice (const :tag "Prompt" nil) + (const "from") (const "to") + (const "cc") (const "all")) + :group 'mh-sending-mail) + + + +;;; Sequences (:group 'mh-sequences) + +;;; If `mh-unpropagated-sequences' becomes a defcustom, add the following to +;;; the docstring: "Additional sequences that should not to be preserved can be +;;; specified by setting `mh-unpropagated-sequences' appropriately." XXX + +(defcustom mh-refile-preserves-sequences-flag t + "*Non-nil means that sequences are preserved when messages are refiled. +If this variable is non-nil and a message belonging to a sequence other than +cur or Previous-Sequence (see mh-profile 5) is refiled then it is put in the +same sequence in the destination folder." + :type 'boolean + :group 'mh-sequences) + +(defcustom mh-tick-seq 'tick + "The name of the MH sequence for ticked messages. +You would change this option if you already use the `tick' sequence for your +own use. You can also disable all of the ticking functions by choosing the +`Disable Ticking' item but there isn't much advantage to that." + :type '(choice (const :tag "Disable Ticking" nil) + symbol) + :group 'mh-sequences) + +(defcustom mh-update-sequences-after-mh-show-flag t + "*Non-nil means flush MH sequences to disk after message is shown. +Three sequences are maintained internally by MH-E and pushed out to MH when a +message is shown. They include the sequence specified by your +`Unseen-Sequence:' profile entry, `cur', and the sequence listed by +the `mh-tick-seq' option which is `tick' by default. +If you do not like this behavior, set this option to nil. You can then update +the state manually with the \\<mh-folder-mode-map>`\\[mh-execute-commands]', `\\[mh-quit]', or `\\[mh-update-sequences]' commands." + :type 'boolean + :group 'mh-sequences) + + + +;;; Reading Your Mail (:group 'mh-show) (defcustom mh-bury-show-buffer-flag t "*Non-nil means that the displayed show buffer for a folder is buried." @@ -923,10 +1021,11 @@ first one found is used." :group 'mh-show) (defcustom mh-clean-message-header-flag t - "*Non-nil means clean headers of messages that are displayed or inserted. -The variable `mh-invisible-headers' if set determines the header fields that -are displayed. If it isn't set, then the variable `mh-invisible-headers' -determines the header fields that are removed." + "*Non-nil means remove extraneous header fields. +The header fields listed in the `mh-invisible-header-fields-default' option +are hidden, although you can check off any field that you would like to see. +Header fields that you would like to hide that aren't listed can be added to +the `mh-invisible-header-fields' option." :type 'boolean :group 'mh-show) @@ -960,19 +1059,28 @@ question." :type 'boolean :group 'mh-show) -(defcustom mh-fetch-x-image-url nil - "Control fetching of X-Image-URL header field image. -This setting only has effect if `mh-show-use-xface-flag' is non-nil. +(defcustom mh-fetch-x-image-url 'ask + "*Control fetching of `X-Image-URL:' header field image. +If set to \"Always fetch\" (t), the image is always fetched. You probably want +to avoid this setting for privacy and DOS (denial of service) reasons. For +example, fetching a URL can tip off a spammer that you've read his email. +Someone may also flood your network and fill your disk drive by sending a +torrent of messages, each specifying a unique URL to a very large file. + +If set to \"Ask before fetching\" ('ask), you are prompted before the image is +fetched. MH-E will remember your reply and will either use the already fetched +image the next time the same URL is encountered or silently skip it if you +didn't fetch it the first time. This is the default. -If set to t, the image is fetched. +If set to \"Never fetch\" (nil), images are never fetched and only displayed +if they are already present in the cache. -If set to 'ask, the user is prompted before the image is fetched. MH-E will -remember your reply and will either use the already fetched image the next time -the same URL is encountered or silently skip it if you didn't fetch it the -first time. +The cache of images is found in the directory `.mhe-x-image-cache' within your +MH directory. To see how you can add your own face to the `From:' field, see +`mh-x-face-file'. + +This setting only has effect if `mh-show-use-xface-flag' is non-nil." -If set to nil, the default, images are not fetched and only displayed if they -are already present in the cache." :type '(choice (const :tag "Always fetch" t) (const :tag "Ask before fetching" ask) (const :tag "Never fetch" nil)) @@ -1002,28 +1110,8 @@ The gnus method uses a different color for each indentation." (const :tag "Don't fontify" nil)) :group 'mh-show) -(defvar mh-invisible-headers nil - "*Regexp matching lines in a message header that are not to be shown. -Customize the variable `mh-invisible-header-fields' to generate this variable; -It will in turn automatically use the function `mh-invisible-headers' to -generate this variable. -If the variable `mh-visible-headers' is non-nil, it is used instead to specify -what to keep.") - -(defun mh-invisible-headers () - "Make or remake the variable `mh-invisible-headers'. -Done using `mh-invisible-header-fields' as input." - (if mh-invisible-header-fields - (setq mh-invisible-headers - (concat - "^" - (let ((max-specpdl-size 1000) ;workaround for insufficient default - (fields mh-invisible-header-fields)) - (regexp-opt fields t)))) - (setq mh-invisible-headers nil))) - ;; Keep fields alphabetized. Mention source, if known. -(defcustom mh-invisible-header-fields +(defvar mh-invisible-header-fields-internal '("Approved:" "Autoforwarded:" "Bestservhost:" @@ -1053,12 +1141,13 @@ Done using `mh-invisible-header-fields' as input." "Old-Return-Path:" "Original-Encoded-Information-Types:" ; X400 "Original-Lines:" ; mail to news - "Original-Newsgroups:" ; mail to news "Original-NNTP-" ; mail to news + "Original-Newsgroups:" ; mail to news "Original-Path:" ; mail to news "Original-Received:" ; mail to news "Original-To:" ; mail to news "Original-X-" ; mail to news + "Originator:" "P1-Content-Type:" ; X400 "P1-Message-Id:" ; X400 "P1-Recipient:" ; X400 @@ -1074,13 +1163,17 @@ Done using `mh-invisible-header-fields' as input." "Return-Path:" ; RFC 822 "Sensitivity:" ; MS Outlook "Status:" ; sendmail + "Thread-" "Ua-Content-Id:" ; X400 ;; "User-Agent:" ; Similar to X-Mailer, so display it. "Via:" ; MH "X-Abuse-Info:" + "X-Abuse-and-DMCA-" "X-Accept-Language:" "X-Accept-Language:" ; Netscape/Mozilla "X-Ack:" + "X-Administrivia-To:" + "X-AntiAbuse:" ; cPanel "X-Apparently-From:" ; MS Outlook "X-Apparently-To:" ; Egroups/yahoogroups mailing list manager "X-Authentication-Warning:" ; sendmail @@ -1088,13 +1181,18 @@ Done using `mh-invisible-header-fields' as input." "X-Bogosity:" ; bogofilter "X-Complaints-To:" "X-Cron-Env:" + "X-DMCA" "X-Delivered" + "X-ELNK-Trace:" ; Earthlink mailer + "X-Envelope-Date:" ; GNU mailutils + "X-Envelope-From:" "X-Envelope-Sender:" "X-Envelope-To:" "X-Face:" "X-Folder:" ; Spam "X-From-Line" "X-Gnus-Mail-Source:" ; gnus + "X-Greylist:" ; milter-greylist-1.2.1 "X-Habeas-SWE-1:" ; Spam "X-Habeas-SWE-2:" ; Spam "X-Habeas-SWE-3:" ; Spam @@ -1104,27 +1202,35 @@ Done using `mh-invisible-header-fields' as input." "X-Habeas-SWE-7:" ; Spam "X-Habeas-SWE-8:" ; Spam "X-Habeas-SWE-9:" ; Spam + "X-Image-URL:" ; URL equivalent of X-Face and Face "X-Info:" ; NTMail "X-Juno-" ; Juno "X-List-Host:" ; Unknown mailing list managers "X-List-Subscribe:" ; Unknown mailing list managers "X-List-Unsubscribe:" ; Unknown mailing list managers + "X-Listprocessor-" ; ListProc(tm) by CREN "X-Listserver:" ; Unknown mailing list managers "X-Loop:" ; Unknown mailing list managers + "X-MHE-Checksum" ; Checksum added during index search "X-MIME-Autoconverted:" ; sendmail "X-MIMETrack:" - "X-MS-TNEF-Correlator:" ; MS Outlook + "X-Mms-" ; T-Mobile pictures + "X-MS-" ; MS Outlook + "X-MailScanner" ; ListProc(tm) by CREN "X-Mailing-List:" ; Unknown mailing list managers "X-Mailman-Version:" ; Mailman mailing list manager "X-Majordomo:" ; Majordomo mailing list manager "X-Message-Id" - "X-MHE-Checksum" ; Checksum added during index search + "X-MessageWall-Score:" ; Unknown mailing list manager, AUC TeX "X-MimeOLE:" ; MS Outlook "X-Mozilla-Status:" ; Netscape/Mozilla "X-Msmail-" ; MS Outlook + "X-NAI-Spam-" ; Network Associates Inc. SpamKiller "X-News:" ; News "X-No-Archive:" "X-Notes-Item:" ; Lotus Notes Domino structured header + "X-OperatingSystem:" + ;;"X-Operator:" ; Similar to X-Mailer, so display it "X-Orcl-Content-Type:" "X-Original-Complaints-To:" "X-Original-Date:" ; SourceForge mailing list manager @@ -1132,8 +1238,10 @@ Done using `mh-invisible-header-fields' as input." "X-Original-Trace:" "X-OriginalArrivalTime:" ; Hotmail "X-Originating-IP:" ; Hotmail + "X-Postfilter:" "X-Priority:" ; MS Outlook "X-Qotd-" ; User added + "X-RM" "X-Received-Date:" "X-Received:" "X-Request-" @@ -1141,38 +1249,108 @@ Done using `mh-invisible-header-fields' as input." "X-SBNote:" ; Spam "X-SBPass:" ; Spam "X-SBRule:" ; Spam + "X-SMTP-" "X-Scanned-By" "X-Sender:" "X-Server-Date:" "X-Server-Uuid:" "X-Sieve:" ; Sieve filtering - "X-Spam-Checker-Version:" ; Spamassassin - "X-Spam-Level:" ; Spamassassin - "X-Spam-Score:" ; Spamassassin - "X-Spam-Status:" ; Spamassassin + "X-Source" + "X-Spam-" ; Spamassassin "X-SpamBouncer:" ; Spam + "X-Status" + "X-Submissions-To:" + "X-Telecom-Digest" "X-Trace:" + "X-UID" "X-UIDL:" "X-UserInfo1:" "X-VSMLoop:" ; NTMail "X-Vms-To:" + "X-WebTV-Signature:" "X-Wss-Id:" ; Worldtalk gateways + "X-Yahoo" "X-eGroups-" ; Egroups/yahoogroups mailing list manager "X-pgp:" "X-submission-address:" "X400-" ; X400 "Xref:") -"*List of header fields that are not to be shown. -Regexps are not allowed. Unique fields should have a \":\" suffix; otherwise, -the element can be used to render invisible an entire class of fields that -start with the same prefix. -This variable is ignored if the variable `mh-visible-headers' is set." + "List of default header fields that are not to be shown. +Do not alter this variable directly. Instead, add entries from here that you +would like to be displayed in `mh-invisible-header-fields-default' +and add entries to hide in `mh-invisible-header-fields'.") + +(defvar mh-invisible-header-fields-compiled nil + "*Regexp matching lines in a message header that are not to be shown. +Do not alter this variable directly. Instead, customize +`mh-invisible-header-fields-default' checking for fields normally +hidden that you wish to display, and add extra entries to hide in +`mh-invisible-header-fields'.") + +(defun mh-invisible-headers () + "Make or remake the variable `mh-invisible-header-fields-compiled'. +Done using `mh-invisible-header-fields-internal' as input, from which entries +from `mh-invisible-header-fields-default' are removed and entries +from `mh-invisible-header-fields' are added." + (let ((fields mh-invisible-header-fields-internal)) + (when mh-invisible-header-fields-default + ;; Remove entries from `mh-invisible-header-fields-default' + (setq fields + (loop for x in fields + unless (member x mh-invisible-header-fields-default) + collect x))) + (when (and (boundp 'mh-invisible-header-fields) + mh-invisible-header-fields) + (dolist (x mh-invisible-header-fields) + (unless (member x fields) (setq fields (cons x fields))))) + (if fields + (setq mh-invisible-header-fields-compiled + (concat + "^" + ;; workaround for insufficient default + (let ((max-specpdl-size 1000)) + (regexp-opt fields t)))) + (setq mh-invisible-header-fields-compiled nil)))) + +(defcustom mh-invisible-header-fields-default nil + "*List of hidden header fields. +The header fields listed in this option are hidden, although you can check off +any field that you would like to see. Header fields that you would like to +hide that aren't listed can be added to the `mh-invisible-header-fields' +option. + +See also `mh-clean-message-header-flag'." + :type `(set ,@(mapcar (lambda (x) `(const ,x)) + mh-invisible-header-fields-internal)) + :set (lambda (symbol value) + (set-default symbol value) + (mh-invisible-headers)) + :group 'mh-show) + +(defcustom mh-invisible-header-fields nil + "*Additional header fields to hide. +Header fields that you would like to hide that aren't listed in +`mh-invisible-header-fields-default' can be added to this option with a couple +of caveats. Regular expressions are not allowed. Unique fields should have a +`:' suffix; otherwise, the element can be used to render invisible an entire +class of fields that start with the same prefix. + +See also `mh-clean-message-header-flag'." + :type '(repeat (string :tag "Header field")) :set (lambda (symbol value) (set-default symbol value) (mh-invisible-headers)) :group 'mh-show) +(defcustom mh-lpr-command-format "lpr -J '%s'" + "*Format for Unix command that prints a message. +The string should be a Unix command line, with the string '%s' where +the job's name (folder and message number) should appear. The formatted +message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'." + :type 'string + :group 'mh-show) + (defcustom mh-max-inline-image-height nil "*Maximum inline image height if Content-Disposition is not present. If nil, image will be displayed if its height is smaller than the height of @@ -1187,6 +1365,27 @@ window." :type '(choice (const nil) integer) :group 'mh-show) +(defcustom mh-mime-save-parts-default-directory t + "Default directory to use for `mh-mime-save-parts'. +If nil, prompt and set for next time the command is used during same session. +If t, prompt always" + :type '(choice (const :tag "Prompt the first time" nil) + (const :tag "Prompt always" t) + directory) + :group 'mh-show) + +(defcustom mh-print-background-flag nil + "*Non-nil means messages should be printed in the background. +WARNING: do not delete the messages until printing is finished; +otherwise, your output may be truncated." + :type 'boolean + :group 'mh-show) + +(defcustom mh-recursive-folders-flag nil + "*Non-nil means that commands which operate on folders do so recursively." + :type 'boolean + :group 'mh-show) + (defcustom mh-show-maximum-size 0 "*Maximum size of message (in bytes) to display automatically. Provides an opportunity to skip over large messages which may be slow to load. @@ -1194,6 +1393,14 @@ Use a value of 0 to display all messages automatically regardless of size." :type 'integer :group 'mh-show) +(defcustom mh-show-threads-flag nil + "Non-nil means new folders start in threaded mode. +Threading large number of messages can be time consuming. So if the flag is +non-nil then threading will be done only if the number of messages being +threaded is less than `mh-large-folder'." + :type 'boolean + :group 'mh-show) + ;; Use goto-addr if it was already loaded (which probably sets this ;; variable to t), or if this variable is otherwise set to t. (defcustom mh-show-use-goto-addr-flag (and (boundp 'goto-address-highlight-p) @@ -1205,80 +1412,55 @@ The `goto-addr' module is used." (defcustom mh-show-use-xface-flag (>= emacs-major-version 21) "*Non-nil means display face images in `mh-show-mode'. -This flag controls the display of three kinds of faces. - -The first is the traditional X-Face header field. For GNU Emacs 21 -and above, the `uncompface' binary is required to be in the execute -PATH for the display of X-Face images. It can be obtained from -ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z. - -If the XEmacs you are using has internal support for X-Face images, then MH-E -will display X-Face images in XEmacs \"out of the box\". Even if you don't have -X-Face support compiled into your XEmacs, you can still see the X-Face images -in MH-E with the aid of an external x-face package and `uncompface'. It is -available from ftp://ftp.jpl.org/pub/elisp/. Download it, put its files in the -`load-path' and MH-E will invoke it automatically. - -Second, MH-E supports the display of the Gnus-specific Face -header field in GNU Emacs >= 21 and XEmacs. No external packages -are required. More information about the Face header can be found -at: http://quimby.gnus.org/circus/face/. - -Finally, MH-E can also display images from the X-Image-URL header field. The -display of the images requires the `wget' program, available from -http://www.gnu.org/software/wget/wget.html, to fetch the image and the -`convert' program from the ImageMagick suite, available from + +MH-E can display the content of `Face:', `X-Face:', and `X-Image-URL:' header +fields. If any of these fields occur in the header of your message, the +sender's face will appear in the `From:' header field. If more than one of +these fields appear, then the first field found in the order `Face:', +`X-Face:', and `X-Image-URL:' will be used. Note that versions of GNU Emacs +prior to 21.1 don't support the display of inline images, so face images are +not displayed in these versions. + +The option `mh-show-use-xface-flag' is used to turn this feature on and off. +This feature will be turned on by default if your system supports it. + +The first header field used, if present, is the Gnus-specific `Face:' field. +The `Face:' field appeared in GNU Emacs 21 and XEmacs. For more information, +see http://quimby.gnus.org/circus/face/. Next is the traditional `X-Face:' +header field. The display of this field requires the `uncompface' program +which can be obtained from +ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z. Recent versions of +XEmacs have internal support for `X-Face:' images. If your version of XEmacs +does not, then you'll need both `uncompface' and the x-face package which is +available at ftp://ftp.jpl.org/pub/elisp/. + +Finally, MH-E will display images referenced by the `X-Image-URL:' header +field if neither the `Face:' nor the `X-Face:' fields are present. The display +of the images requires `wget' (available from +http://www.gnu.org/software/wget/wget.html), `fetch', or `curl' to fetch the +image and the `convert' program from the ImageMagick suite, available from http://www.imagemagick.org/. Of the three header fields this is the most efficient in terms of network usage since the image doesn't need to be -transmitted with every single mail. However its display needs the recipient to -fetch a URL and this can be misused. So it is disabled by default. It can be -enabled by customizing `mh-fetch-x-image-url'. Setting that to ask for -confirmation before fetching seems like a good choice. +transmitted with every single mail. -Versions of GNU Emacs prior to 21.1 don't support the display of -inline images. So face images are not displayed in these versions." +The option `mh-fetch-x-image-url' controls the fetching of the `X-Image-URL:' +header field image." :type 'boolean :group 'mh-show) +(defcustom mh-store-default-directory nil + "*Last directory used by \\[mh-store-msg]; default for next store. +A directory name string, or nil to use current directory." + :type '(choice (const :tag "Current" nil) + directory) + :group 'mh-show) + (defcustom mh-summary-height nil "*Number of lines in MH-Folder window (including the mode line)." :type '(choice (const :tag "Automatic" nil) (integer :tag "Fixed sized")) :group 'mh-show) -(defvar mh-visible-headers nil - "*Regexp matching lines in a message header that are to be shown. -Customize the variable `mh-visible-header-fields' to generate this variable; -It will in turn automatically use the function `mh-visible-headers' to -generate this variable. -Only used if `mh-clean-message-header-flag' is non-nil. Setting it overrides -the variable `mh-invisible-headers'.") - -(defun mh-visible-headers () - "Make or remake the variable `mh-visible-headers'. -Done using `mh-visible-header-fields' as input." - (if mh-visible-header-fields - (setq mh-visible-headers - (concat - "^" - (let ((max-specpdl-size 1000) ;workaround for insufficient default - (fields mh-visible-header-fields)) - (regexp-opt fields t)))) - (setq mh-visible-headers nil))) - -(defcustom mh-visible-header-fields nil -"*List of header fields that are to be shown. -Regexps are not allowed. Unique fields should have a \":\" suffix; otherwise, -the element can be used to render visible an entire class of fields that -start with the same prefix. -Only used if `mh-clean-message-header-flag' is non-nil. -Setting it overrides the variable `mh-invisible-headers'." - :type '(repeat (string :tag "Header field")) - :set (lambda (symbol value) - (set-default symbol value) - (mh-visible-headers)) - :group 'mh-show) - (defcustom mhl-formfile nil "*Name of format file to be used by mhl to show and print messages. A value of t means use the default format file. @@ -1292,387 +1474,489 @@ the message continues to conform to RFC 822 and MH-E can parse the headers." -;;; Composing messages (:group 'mh-letter) - -(defcustom mh-compose-insertion (if (locate-library "mml") 'gnus 'mhn) - "Use either 'gnus or 'mhn to insert MIME message directives in messages." - :type '(choice (const :tag "Use Gnus" gnus) - (const :tag "Use mhn" mhn)) - :group 'mh-letter) - -(defcustom mh-compose-letter-function nil - "Invoked when setting up a letter draft. -It is passed three arguments: TO recipients, SUBJECT, and CC recipients." - :type '(choice (const nil) function) - :group 'mh-letter) - -(defcustom mh-compose-prompt-flag nil - "*Non-nil means prompt for header fields when composing a new draft." - :type 'boolean - :group 'mh-letter) - -(defcustom mh-compose-skipped-header-fields - '("from" "organization" "references" "in-reply-to" "x-face" "face" - "x-mailer") - "List of header fields to skip over when navigating in draft." - :type '(repeat (string :tag "Field")) - :group 'mh-letter) - -(defcustom mh-compose-space-does-completion-flag nil - "*Non-nil means that SPACE does completion in message header." - :type 'boolean - :group 'mh-letter) - -(defcustom mh-delete-yanked-msg-window-flag nil - "*Non-nil means delete any window displaying the message. -Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. -If non-nil, yanking the current message into a draft letter deletes any -windows displaying the message." - :type 'boolean - :group 'mh-letter) - -(defcustom 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]." - :type '(choice (const "wrote:") - (const "a écrit :") - (string :tag "Custom string")) - :group 'mh-letter) +;;; The Speedbar (:group 'mh-speed) -(defcustom mh-forward-subject-format "%s: %s" - "*Format to generate the Subject: line contents for a forwarded message. -The two string arguments to the format are the sender of the original -message and the original subject line." - :type 'string - :group 'mh-letter) - -(defcustom mh-ins-buf-prefix "> " - "*String to put before each non-blank line of a yanked or inserted message. -\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter -by \\[mh-insert-letter] or \\[mh-yank-cur-msg]." - :type 'string - :group 'mh-letter) - -(defcustom mh-insert-x-mailer-flag t - "*Non-nil means append an X-Mailer field to the header." - :type 'boolean - :group 'mh-letter) - -(defcustom mh-letter-complete-function 'ispell-complete-word - "*Function to call when completing outside of fields specific to aliases." - :type '(choice function (const nil)) - :group 'mh-letter) +(defcustom 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 in it exceed +this value, then confirmation is needed when it is visited. Even when +`mh-show-threads-flag' is non-nil, the folder 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-speed) -(defcustom mh-letter-fill-column 72 - "*Fill column to use in `mh-letter-mode'. -This is usually less than in other text modes because email messages get -quoted by some prefix (sometimes many times) when they are replied to, -and it's best to avoid quoted lines that span more than 80 columns." +(defcustom mh-speed-flists-interval 60 + "Time between calls to flists in seconds. +If 0, flists is not called repeatedly." :type 'integer - :group 'mh-letter) - -(defcustom mh-reply-default-reply-to nil - "*Sets the person or persons to whom a reply will be sent. -If nil, prompt for recipient. If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this -value and it should be one of \"from\", \"to\", \"cc\", or \"all\". -The values \"cc\" and \"all\" do the same thing." - :type '(choice (const :tag "Prompt" nil) - (const "from") (const "to") - (const "cc") (const "all")) - :group 'mh-letter) - -(defcustom mh-reply-show-message-flag t - "*Non-nil means the show buffer is displayed using \\<mh-letter-mode-map>\\[mh-reply]. + :group 'mh-speed) -The setting of this variable determines whether the MH `show-buffer' is -displayed with the current message when using `mh-reply' without a prefix -argument. Set it to nil if you already include the message automatically -in your draft using - repl: -filter repl.filter -in your ~/.mh_profile file." +(defcustom mh-speed-run-flists-flag t + "Non-nil means flists is used. +If non-nil, flists is executed every `mh-speed-flists-interval' seconds to +update the display of the number of unseen and total messages in each folder. +If resources are limited, this can be set to nil and the speedbar display can +be updated manually with the \\[mh-speed-flists] command." :type 'boolean - :group 'mh-letter) - -(defcustom mh-signature-file-name "~/.signature" - "*Name of file containing the user's signature. -Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature]." - :type 'file - :group 'mh-letter) - -(defcustom mh-x-face-file "~/.face" - "*File containing X-Face or Face header field to insert in outgoing mail. - -If the file starts with either of the strings \"X-Face: \", \"Face: \" or -\"X-Image-URL: \" then it is assumed to contain the whole field and is added to -the message header verbatim. Otherwise it is assumed that the file contains the -value of the X-Face header field. - -X-Face header fields can be generated using `compface', which can be obtained -from ftp://ftp.cs.indiana.edu/pub/faces/compface/compface.tar.Z. The \"Online -X-Face Convertor\" at http://www.dairiki.org/xface/ is a useful resource for -quick conversion of images into X-Face header fields. - -There is a `make-face' script that converts a jpeg image to a Face header -field at http://quimby.gnus.org/circus/face/make-face. - -The URL of any image can be used for the X-Image-URL field and no processing -of the image is required. + :group 'mh-speed) -If nil, or the file does not exist, nothing is added to the message header." - :type 'file - :group 'mh-letter) + -(defcustom mh-yank-from-start-of-msg 'attribution - "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg]. -If t, include the entire message, with full headers. This is historically -here for use with supercite, but is now deprecated in favor of the setting -`supercite' below. +;;; The Toolbar (:group 'mh-toolbar) -If the symbol `body', then yank the message minus the header. +(defcustom mh-tool-bar-search-function 'mh-search-folder + "*Function called by the tool-bar search button. +See `mh-search-folder' and `mh-index-search' for details." + :type '(choice (const mh-search-folder) + (const mh-index-search) + (function :tag "Other function")) + :group 'mh-toolbar) -If the symbol `supercite', include the entire message, with full headers. -This also causes the invocation of `sc-cite-original' without the setting -of `mail-citation-hook', now deprecated practice. +;; Functions called from the tool bar +(defun mh-tool-bar-search (&optional arg) + "Interactively call `mh-tool-bar-search-function'. +Optional argument ARG is not used." + (interactive "P") + (call-interactively mh-tool-bar-search-function)) -If the symbol `autosupercite', do as for `supercite' automatically when -show buffer matches the message being replied-to. When this option is used, -the -noformat switch is passed to the repl program to override a -filter or --format switch. +(defun mh-tool-bar-customize () + "Call `mh-customize' from the toolbar." + (interactive) + (mh-customize t)) -If the symbol `attribution', then yank the message minus the header and add -a simple attribution line at the top. +(defun mh-tool-bar-folder-help () + "Visit \"(mh-e)Top\"." + (interactive) + (Info-goto-node "(mh-e)Top") + (delete-other-windows)) -If the symbol `autoattrib', do as for `attribution' automatically when show -buffer matches the message being replied-to. You can make sure this is -always the case by setting `mh-reply-show-message-flag' to t (which is the -default) and optionally `mh-delete-yanked-msg-window-flag' to t as well such -that the show window is never displayed. When the `autoattrib' option is -used, the -noformat switch is passed to the repl program to override a --filter or -format switch. +(defun mh-tool-bar-letter-help () + "Visit \"(mh-e)Draft Editing\"." + (interactive) + (Info-goto-node "(mh-e)Draft Editing") + (delete-other-windows)) -If nil, yank only the portion of the message following the point. +(defmacro mh-tool-bar-reply-generator (function recipient folder-buffer-flag) + "Generate FUNCTION that replies to RECIPIENT. +If FOLDER-BUFFER-FLAG is nil then the function generated +When INCLUDE-FLAG is non-nil, include message body being replied to." + `(defun ,function (&optional arg) + ,(format "Reply to \"%s\".\nWhen ARG is non-nil include message in reply." + recipient) + (interactive "P") + ,(if folder-buffer-flag nil '(set-buffer mh-show-folder-buffer)) + (mh-reply (mh-get-msg-num nil) ,recipient arg))) -If the show buffer has a region, this variable is ignored unless its value is -one of `attribution' or `autoattrib' in which case the attribution is added -to the yanked region." - :type '(choice (const :tag "Below point" nil) - (const :tag "Without header" body) - (const :tag "Invoke supercite" supercite) - (const :tag "Invoke supercite, automatically" autosupercite) - (const :tag "Without header, with attribution" attribution) - (const :tag "Without header, with attribution, automatically" - autoattrib) - (const :tag "Entire message with headers" t)) - :group 'mh-letter) +(mh-tool-bar-reply-generator mh-tool-bar-reply-from "from" t) +(mh-tool-bar-reply-generator mh-show-tool-bar-reply-from "from" nil) +(mh-tool-bar-reply-generator mh-tool-bar-reply-to "to" t) +(mh-tool-bar-reply-generator mh-show-tool-bar-reply-to "to" nil) +(mh-tool-bar-reply-generator mh-tool-bar-reply-all "all" t) +(mh-tool-bar-reply-generator mh-show-tool-bar-reply-all "all" nil) - +;; XEmacs has a couple of extra customizations... +(mh-do-in-xemacs + (defcustom mh-xemacs-use-toolbar-flag (if (and (featurep 'toolbar) + (featurep 'xpm) + (device-on-window-system-p)) + t + nil) + "*If non-nil, use toolbar. -;;; Alias handling (:group 'mh-alias) +This will default to t if you are in an environment that supports +toolbars and xpm." + :type 'boolean + :group 'mh-toolbar) -(defcustom mh-alias-completion-ignore-case-flag t - "*Non-nil means don't consider case significant in MH alias completion. -This is the default in plain MH, so it is the default here as well. It -can be useful to set this to t if, for example, you use lowercase -aliases for people and uppercase for mailing lists." - :type 'boolean - :group 'mh-alias) + (defcustom mh-xemacs-toolbar-position (if mh-xemacs-use-toolbar-flag + 'default + nil) + "*Where to put the toolbar. -(defcustom 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 expanded to the full -address in the message draft. By default, this expansion is not performed." - :type 'boolean - :group 'mh-alias) +Valid non-nil values are \"default\", \"top\", \"bottom\", \"left\", +\"right\". These match the four edges of the frame, with \"default\" +meaning \"use the same position as the default-toolbar\". -(defcustom mh-alias-flash-on-comma t - "*Specify whether to flash or warn on translation. -When a [comma] is pressed while entering aliases or addresses, setting this -variable to the following values has the listed effects: -t Flash alias translation but don't warn if there is no translation. -1 Flash alias translation and warn if there is no translation. -nil Do not flash alias translation nor warn if there is no translation." - :type '(choice (const :tag "Flash but don't warn if no translation" t) - (const :tag "Flash and warn if no translation" 1) - (const :tag "Don't flash nor warn if no translation" nil)) - :group 'mh-alias) +A nil value means do not use a toolbar. -(defcustom mh-alias-insert-file nil - "*Filename to use to store new MH-E aliases. -This variable can also be a list of filenames, in which case MH-E will prompt -for one of them. If nil, the default, then MH-E will use the first file found -in the \"AliasFile\" component of the MH profile." - :type '(choice (const :tag "Use AliasFile MH profile component" nil) - (file :tag "Alias file") - (repeat :tag "List of alias files" file)) - :group 'mh-alias) +If this variable is set to anything other than \"default\" and the +default-toolbar has a different positional setting from the value of +this variable, then two toolbars will be displayed. The MH-E toolbar +and the default-toolbar." + :type '(radio (const :tag "Same position as the \"default-toolbar\"" + :value default) + (const :tag "Along the top edge of the frame" + :value top) + (const :tag "Along the bottom edge of the frame" + :value bottom) + (const :tag "Along the left edge of the frame" + :value left) + (const :tag "Along the right edge of the frame" + :value right) + (const :tag "Don't use a toolbar" nil)) + :group 'mh-toolbar)) -(defcustom mh-alias-insertion-location 'sorted - "Specifies where new aliases are entered in alias files. -Options are sorted alphabetically, at the top of the file or at the bottom." - :type '(choice (const :tag "Sorted alphabetically" sorted) - (const :tag "At the top of file" top) - (const :tag "At the bottom of file" bottom)) - :group 'mh-alias) +(defmacro mh-tool-bar-define (defaults &rest buttons) + "Define a tool bar for MH-E. +DEFAULTS is the list of buttons that are present by default. It is a list of +lists where the sublists are of the following form: -(defcustom mh-alias-local-users t - "*If t, local users are completed in MH-E To: and Cc: prompts. + (:KEYWORD FUNC1 FUNC2 FUNC3 ...) -Users with a userid greater than some magic number (usually 200) are available -for completion. +Here :KEYWORD is one of :folder or :letter. If it is :folder then the default +buttons in the folder and show mode buffers are being specified. If it is +:letter then the default buttons in the letter mode are listed. FUNC1, FUNC2, +FUNC3, ... are the names of the functions that the buttons would execute. -If you set this variable to a string, it will be executed to generate a -password file. A value of \"ypcat passwd\" is helpful if NIS is in use." - :type '(choice (boolean) (string)) - :group 'mh-alias) +Each element of BUTTONS is a list consisting of four mandatory items and one +optional item as follows: -(defcustom mh-alias-local-users-prefix "local." - "*String prepended to the real names of users from the passwd file. -If nil, use the username string unmodified instead of the real name from -the gecos field of the passwd file. + (FUNCTION MODES ICON DOC &optional ENABLE-EXPR) -For example, given the following passwd file line: +where, - psg:x:1000:1000:Peter S Galbraith,,,:/home/psg:/bin/tcsh + FUNCTION is the name of the function that will be executed when the button + is clicked. -here are the derived aliases for different values of this variable: + MODES is a list of symbols. List elements must be from `folder', `letter' and + `sequence'. If `folder' is present then the button is available in the + folder and show buffer. If the name of FUNCTION is of the form \"mh-foo\", + where foo is some arbitrary string, then we check if the function + `mh-show-foo' exists. If it exists then that function is used in the show + buffer. Otherwise the original function `mh-foo' is used in the show buffer + as well. Presence of `sequence' is handled similar to the above. The only + difference is that the button is shown only when the folder is narrowed to a + sequence. If `letter' is present in MODES, then the button is available + during draft editing and runs FUNCTION when clicked. - \"local.\" -> local.peter.galbraith - \"\" -> peter.galbraith - nii -> psg + ICON is the icon that is drawn in the button. -This variable is only meaningful if the variable `mh-alias-local-users' is -non-nil." - :type '(choice (const :tag "Use username instead of real name" nil) - (string)) - :group 'mh-alias) + DOC is the documentation for the button. It is used in tool-tips and in + providing other help to the user. GNU Emacs uses only the first line of the + string. So the DOC should be formatted such that the first line is useful and + complete without the rest of the string. -(defcustom mh-alias-passwd-gecos-comma-separator-flag t - "*Non-nil means the gecos field in the passwd file uses comma as a separator. -Used to construct aliases for users in the passwd file." - :type 'boolean - :group 'mh-alias) + Optional item ENABLE-EXPR is an arbitrary lisp expression. If it evaluates + to nil, then the button is deactivated, otherwise it is active. If is in't + present then the button is always active." + ;; The following variable names have been carefully chosen to make code + ;; generation easier. Modifying the names should be done carefully. + (let (folder-buttons folder-docs folder-button-setter sequence-button-setter + show-buttons show-button-setter show-seq-button-setter + letter-buttons letter-docs letter-button-setter + folder-defaults letter-defaults + folder-vectors show-vectors letter-vectors) + (dolist (x defaults) + (cond ((eq (car x) :folder) (setq folder-defaults (cdr x))) + ((eq (car x) :letter) (setq letter-defaults (cdr x))))) + (dolist (button buttons) + (unless (and (listp button) + (or (equal (length button) 4) (equal (length button) 5))) + (error "Incorrect MH-E tool-bar button specification: %s" button)) + (let* ((name (nth 0 button)) + (name-str (symbol-name name)) + (icon (nth 2 button)) + (xemacs-icon (mh-do-in-xemacs + (cdr (assoc (intern icon) mh-xemacs-icon-map)))) + (full-doc (nth 3 button)) + (doc (if (string-match "\\(.*\\)\n" full-doc) + (match-string 1 full-doc) + full-doc)) + (enable-expr (or (nth 4 button) t)) + (modes (nth 1 button)) + functions show-sym) + (when (memq 'letter modes) (setq functions `(:letter ,name))) + (when (or (memq 'folder modes) (memq 'sequence modes)) + (setq functions + (append `(,(if (memq 'folder modes) :folder :sequence) ,name) + functions)) + (setq show-sym + (if (string-match "^mh-\\(.*\\)$" name-str) + (intern (concat "mh-show-" (match-string 1 name-str))) + name)) + (setq functions + (append `(,(if (memq 'folder modes) :show :show-seq) + ,(if (fboundp show-sym) show-sym name)) + functions))) + (do ((functions functions (cddr functions))) + ((null functions)) + (let* ((type (car functions)) + (function (cadr functions)) + (type1 (substring (symbol-name type) 1)) + (vector-list (cond ((eq type :show) 'show-vectors) + ((eq type :show-seq) 'show-vectors) + ((eq type :letter) 'letter-vectors) + (t 'folder-vectors))) + (list (cond ((eq type :letter) 'mh-tool-bar-letter-buttons) + (t 'mh-tool-bar-folder-buttons))) + (key (intern (concat "mh-" type1 "toolbar-" name-str))) + (setter (intern (concat type1 "-button-setter"))) + (mbuttons (cond ((eq type :letter) 'letter-buttons) + ((eq type :show) 'show-buttons) + ((eq type :show-seq) 'show-buttons) + (t 'folder-buttons))) + (docs (cond ((eq mbuttons 'letter-buttons) 'letter-docs) + ((eq mbuttons 'folder-buttons) 'folder-docs)))) + (add-to-list vector-list `[,xemacs-icon ,function t ,full-doc]) + (add-to-list + setter `(when (member ',name ,list) + (mh-funcall-if-exists + tool-bar-add-item ,icon ',function ',key + :help ,doc :enable ',enable-expr))) + (add-to-list mbuttons name) + (if docs (add-to-list docs doc)))))) + (setq folder-buttons (nreverse folder-buttons) + letter-buttons (nreverse letter-buttons) + show-buttons (nreverse show-buttons) + letter-docs (nreverse letter-docs) + folder-docs (nreverse folder-docs) + folder-vectors (nreverse folder-vectors) + show-vectors (nreverse show-vectors) + letter-vectors (nreverse letter-vectors)) + (dolist (x folder-defaults) + (unless (memq x folder-buttons) + (error "Folder defaults contains unknown button '%s'" x))) + (dolist (x letter-defaults) + (unless (memq x letter-buttons) + (error "Letter defaults contains unknown button '%s'" x))) + `(eval-when (compile load eval) + (defvar mh-folder-tool-bar-map nil) + (defvar mh-folder-seq-tool-bar-map nil) + (defvar mh-show-tool-bar-map nil) + (defvar mh-show-seq-tool-bar-map nil) + (defvar mh-letter-tool-bar-map nil) + ;; GNU Emacs tool bar specific code + (mh-do-in-gnu-emacs + ;; Custom setter functions + (defun mh-tool-bar-folder-buttons-set (symbol value) + "Construct toolbar for `mh-folder-mode' and `mh-show-mode'." + (set-default symbol value) + (setq mh-folder-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse folder-button-setter) + tool-bar-map)) + (setq mh-show-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse show-button-setter) + tool-bar-map)) + (setq mh-show-seq-tool-bar-map + (let ((tool-bar-map (copy-keymap mh-show-tool-bar-map))) + ,@(nreverse show-seq-button-setter) + tool-bar-map)) + (setq mh-folder-seq-tool-bar-map + (let ((tool-bar-map (copy-keymap mh-folder-tool-bar-map))) + ,@(nreverse sequence-button-setter) + tool-bar-map))) + (defun mh-tool-bar-letter-buttons-set (symbol value) + "Construct toolbar for `mh-letter-mode'." + (set-default symbol value) + (setq mh-letter-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap))) + ,@(nreverse letter-button-setter) + tool-bar-map)))) + ;; XEmacs specific code + (mh-do-in-xemacs + (defvar mh-toolbar-folder-vector-map + ',(loop for button in folder-buttons + for vector in folder-vectors + collect (cons button vector))) + (defvar mh-toolbar-show-vector-map + ',(loop for button in show-buttons + for vector in show-vectors + collect (cons button vector))) + (defvar mh-toolbar-letter-vector-map + ',(loop for button in letter-buttons + for vector in letter-vectors + collect (cons button vector))) + (defvar mh-toolbar-folder-buttons nil) + (defvar mh-toolbar-show-buttons nil) + (defvar mh-toolbar-letter-buttons nil) + ;; Custom setter functions + (defun mh-tool-bar-letter-buttons-set (symbol value) + (set-default symbol value) + (when mh-xemacs-has-toolbar-flag + (setq mh-toolbar-letter-buttons + (loop for b in value + collect (cdr (assoc b mh-toolbar-letter-vector-map)))))) + (defun mh-tool-bar-folder-buttons-set (symbol value) + (set-default symbol value) + (when mh-xemacs-has-toolbar-flag + (setq mh-toolbar-folder-buttons + (loop for b in value + collect (cdr (assoc b mh-toolbar-folder-vector-map)))) + (setq mh-toolbar-show-buttons + (loop for b in value + collect (cdr (assoc b mh-toolbar-show-vector-map)))))) + ;; Initialize toolbar + (defun mh-toolbar-init (mode) + "Install toolbar in MODE." + (let ((toolbar (cond ((eq mode :folder) mh-toolbar-folder-buttons) + ((eq mode :letter) mh-toolbar-letter-buttons) + ((eq mode :show) mh-toolbar-show-buttons))) + (height 37) + (width 40) + (buffer (current-buffer))) + (when (and mh-xemacs-toolbar-position mh-xemacs-use-toolbar-flag + mh-xemacs-has-toolbar-flag) + (cond + ((eq mh-xemacs-toolbar-position 'top) + (set-specifier top-toolbar toolbar buffer) + (set-specifier top-toolbar-visible-p t) + (set-specifier top-toolbar-height height)) + ((eq mh-xemacs-toolbar-position 'bottom) + (set-specifier bottom-toolbar toolbar buffer) + (set-specifier bottom-toolbar-visible-p t) + (set-specifier bottom-toolbar-height height)) + ((eq mh-xemacs-toolbar-position 'left) + (set-specifier left-toolbar toolbar buffer) + (set-specifier left-toolbar-visible-p t) + (set-specifier left-toolbar-width width)) + ((eq mh-xemacs-toolbar-position 'right) + (set-specifier right-toolbar toolbar buffer) + (set-specifier right-toolbar-visible-p t) + (set-specifier right-toolbar-width width)) + (t (set-specifier default-toolbar toolbar buffer))))))) + ;; Declare customizable toolbars + (custom-declare-variable + 'mh-tool-bar-folder-buttons + '(list ,@(mapcar (lambda (x) `(quote ,x)) folder-defaults)) + "Choose buttons to include in MH-E folder/show toolbar." + :group 'mh-toolbar :set 'mh-tool-bar-folder-buttons-set + :type '(set ,@(loop for x in folder-buttons + for y in folder-docs + collect `(const :tag ,y ,x)))) + (custom-declare-variable + 'mh-tool-bar-letter-buttons + '(list ,@(mapcar (lambda (x) `(quote ,x)) letter-defaults)) + "Choose buttons to include in MH-E letter toolbar." + :group 'mh-toolbar :set 'mh-tool-bar-letter-buttons-set + :type '(set ,@(loop for x in letter-buttons + for y in letter-docs + collect `(const :tag ,y ,x))))))) -(defcustom mh-alias-system-aliases - '("/etc/nmh/MailAliases" "/usr/lib/mh/MailAliases" "/etc/passwd") - "*A list of system files from which to cull aliases. -If these files are modified, they are automatically reread. This list need -include only system aliases and the passwd file, since personal alias files -listed in your \"AliasFile\" MH profile component are automatically included. -You can update the alias list manually using \\[mh-alias-reload]." - :type '(choice (file) (repeat file)) - :group 'mh-alias) +(mh-tool-bar-define + ((:folder mh-inc-folder mh-mime-save-parts mh-previous-undeleted-msg + mh-page-msg mh-next-undeleted-msg mh-delete-msg mh-refile-msg + mh-undo mh-execute-commands mh-toggle-tick mh-reply + mh-alias-grab-from-field mh-send mh-rescan-folder + mh-tool-bar-search mh-visit-folder + mh-tool-bar-customize mh-tool-bar-folder-help mh-widen) + (:letter mh-send-letter mh-compose-insertion ispell-message save-buffer + undo kill-region menu-bar-kill-ring-save yank mh-fully-kill-draft + mh-tool-bar-customize mh-tool-bar-letter-help)) + ;; Folder/Show buffer buttons + (mh-inc-folder (folder) "mail" + "Incorporate new mail in Inbox +This button runs `mh-inc-folder' which drags any +new mail into your Inbox folder.") + (mh-mime-save-parts (folder) "attach" + "Save MIME parts from this message +This button runs `mh-mime-save-parts' which saves a message's +different parts into separate files.") + (mh-previous-undeleted-msg (folder) "left_arrow" + "Go to the previous undeleted message +This button runs `mh-previous-undeleted-msg'") + (mh-page-msg (folder) "page-down" + "Page the current message forwards\nThis button runs `mh-page-msg'") + (mh-next-undeleted-msg (folder) "right_arrow" + "Go to the next undeleted message\nThe button runs `mh-next-undeleted-msg'") + (mh-delete-msg (folder) "close" + "Mark this message for deletion\nThis button runs `mh-delete-msg'") + (mh-refile-msg (folder) "refile" + "Refile this message\nThis button runs `mh-refile-msg'") + (mh-undo (folder) "undo" "Undo last operation\nThis button runs `undo'" + (mh-outstanding-commands-p)) + (mh-execute-commands (folder) "execute" + "Perform moves and deletes\nThis button runs `mh-execute-commands'" + (mh-outstanding-commands-p)) + (mh-toggle-tick (folder) "highlight" + "Toggle tick mark\nThis button runs `mh-toggle-tick'") + (mh-toggle-showing (folder) "show" + "Toggle showing message\nThis button runs `mh-toggle-showing'") + (mh-tool-bar-reply-from (folder) "reply-from" "Reply to \"from\"") + (mh-tool-bar-reply-to (folder) "reply-to" "Reply to \"to\"") + (mh-tool-bar-reply-all (folder) "reply-all" "Reply to \"all\"") + (mh-reply (folder) "mail/reply2" + "Reply to this message\nThis button runs `mh-reply'") + (mh-alias-grab-from-field (folder) "alias" + "Grab From alias\nThis button runs `mh-alias-grab-from-field'" + (and (mh-extract-from-header-value) (not (mh-alias-for-from-p)))) + (mh-send (folder) "mail_compose" + "Compose new message\nThis button runs `mh-send'") + (mh-rescan-folder (folder) "rescan" + "Rescan this folder\nThis button runs `mh-rescan-folder'") + (mh-pack-folder (folder) "repack" + "Repack this folder\nThis button runs `mh-pack-folder'") + (mh-tool-bar-search (folder) "search" + "Search\nThis button runs `mh-tool-bar-search-function'") + (mh-visit-folder (folder) "fld_open" + "Visit other folder\nThis button runs `mh-visit-folder'") + ;; Letter buffer buttons + (mh-send-letter (letter) "mail_send" "Send this letter") + (mh-compose-insertion (letter) "attach" "Insert attachment") + (ispell-message (letter) "spell" "Check spelling") + (save-buffer (letter) "save" "Save current buffer to its file" + (buffer-modified-p)) + (undo (letter) "undo" "Undo last operation") + (kill-region (letter) "cut" + "Cut (kill) text in region between mark and current position") + (menu-bar-kill-ring-save (letter) "copy" + "Copy text in region between mark and current position") + (yank (letter) "paste" "Paste (yank) text cut or copied earlier") + (mh-fully-kill-draft (letter) "close" "Kill this draft") + ;; Common buttons + (mh-tool-bar-customize (folder letter) "preferences" "MH-E Preferences") + (mh-tool-bar-folder-help (folder) "help" + "Help! (general help)\nThis button runs `Info-goto-node'") + (mh-tool-bar-letter-help (letter) "help" + "Help! (general help)\nThis button runs `Info-goto-node'") + ;; Folder narrowed to sequence buttons + (mh-widen (sequence) "widen" + "Widen from the sequence\nThis button runs `mh-widen'")) -;;; Multiple personalities (:group 'mh-identity) +;;; Hooks (:group 'mh-hooks + group where hook described) -(defcustom mh-identity-list nil - "*List holding MH-E identity. -Omit the colon and trailing space from the field names. -The keyword name \"none\" is reserved for internal use. -Use the keyname name \"signature\" to specify either a signature file or a -function to call to insert a signature at point. - -Providing an empty Value (\"\") will cause the field to be deleted. - -Example entries using the customize interface: - Keyword name: work - From - Value: John Doe <john@work.com> - Organization - Value: Acme Inc. - Keyword name: home - From - Value: John Doe <johndoe@home.net> - Organization - Value: - -This would produce the equivalent of: - (setq mh-identity-list - '((\"work\" - ((\"From\" . \"John Doe <john@work.com>\") - (\"Organization\" . \"Acme Inc.\"))) - (\"home\" - ((\"From\" . \"John Doe <johndoe@home.net>\") - (\"Organization\" . \"\")))))" - :type '(repeat (list :tag "" - (string :tag "Keyword name") - (repeat :tag "At least one pair from below" - (choice (cons :tag "From field" - (const "From") - (string :tag "Value")) - (cons :tag "Organization field" - (const "Organization") - (string :tag "Value")) - (cons :tag "Signature" - (const "signature") - (choice (file) (function))) - (cons :tag "Other field & value pair" - (string :tag "Field") - (string :tag "Value")))))) - :set 'mh-identity-list-set - :group 'mh-identity) +(defcustom mail-citation-hook nil + "*Hook for modifying a citation just inserted in the mail buffer. +Each hook function can find the citation between point and mark. +And each hook function should leave point and mark around the citation +text as modified. -(defcustom mh-auto-fields-list nil - "Alist of addresses for which header lines are automatically inserted. -Each element has the form (REGEXP ((KEYWORD VALUE) (KEYWORD VALUE)). -When the REGEXP appears in the To or cc fields of a message, the corresponding -KEYWORD header field is insert with its VALUE in the message header. +If this hook is entirely empty (nil), the text of the message is inserted +with `mh-ins-buf-prefix' prefixed to each line. -There is one special case for KEYWORD, that of \"identity\", which means to -insert that identity using `mh-insert-identity'. +See also the variable `mh-yank-from-start-of-msg', which controls how +much of the message passed to the hook. -The common KEYWORD cases of \"Mail-Followup-To\" and \"fcc\" are also -prompted for in the customization interface." - :type `(repeat - (list :tag "" - (string :tag "Regular expression to match") - (repeat :tag "At least one pair from below" - (choice - (cons :tag "Identity entry" - (const "identity") - ,(append - '(radio) - (mapcar (function (lambda (arg) `(const ,arg))) - (mapcar 'car mh-identity-list)))) - (cons :tag "fcc field" - (const "fcc") - (string :tag "Value")) - (cons :tag "Mail-Followup-To field" - (const "Mail-Followup-To") - (string :tag "Value")) - (cons :tag "Other field and value pair" - (string :tag "Field") - (string :tag "Value")))))) - :group 'mh-identity) +This hook was historically provided to set up supercite. You may now leave +this nil and set up supercite by setting the variable +`mh-yank-from-start-of-msg' to 'supercite or, for more automatic insertion, +to 'autosupercite. -(defcustom mh-identity-default nil - "Default identity to use when `mh-letter-mode' is called." - ;; Dynamically render :type corresponding to `mh-identity-list' entries, - ;; e.g.: - ;; :type '(radio (const :tag "none" nil) - ;; (const "home") - ;; (const "work")) - :type (append - '(radio) - (cons '(const :tag "None" nil) - (mapcar (function (lambda (arg) `(const ,arg))) - (mapcar 'car mh-identity-list)))) - :group 'mh-identity) - - - -;;; Hooks (:group 'mh-hooks + group where hook defined) +The hook 'trivial-cite is NOT part of Emacs. It is provided from tc.el, +available here: + http://shasta.cs.uiuc.edu/~lrclause/tc.html +If you use it, customize `mh-yank-from-start-of-msg' to + \"Entire message with headers\"." + :type 'hook + :options '(trivial-cite) + :group 'mh-hooks + :group 'mh-letter) -;;; These are alphabetized. All hooks should be placed in the 'mh-hook group; -;;; in addition, add the group in which the hook is defined in the manual (or, -;;; if it is new, where it would be defined). +(defcustom mh-alias-reloaded-hook nil + "Invoked by `mh-alias-reload' after reloading aliases." + :type 'hook + :group 'mh-hooks + :group 'mh-alias) (defcustom mh-before-quit-hook nil "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting MH-E. See also `mh-quit-hook'." :type 'hook :group 'mh-hooks - :group 'mh-folder) + :group 'mh-show) (defcustom mh-before-send-letter-hook nil "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command." @@ -1684,7 +1968,7 @@ See also `mh-quit-hook'." "Invoked after marking each message for deletion." :type 'hook :group 'mh-hooks - :group 'mh-folder) + :group 'mh-show) (defcustom mh-edit-mhn-hook nil "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn]." @@ -1696,13 +1980,13 @@ See also `mh-quit-hook'." "Invoked by `mh-find-path' after reading the user's MH profile." :type 'hook :group 'mh-hooks - :group 'mh-folder) + :group 'mh-show) (defcustom mh-folder-mode-hook nil "Invoked in `mh-folder-mode' on a new folder." :type 'hook :group 'mh-hooks - :group 'mh-folder) + :group 'mh-show) (defcustom mh-folder-updated-hook nil "Invoked when the folder actions (such as moves and deletes) are performed. @@ -1712,11 +1996,17 @@ current folder, `mh-current-folder'." :type 'hook :group 'mh-hooks) +(defcustom mh-forward-hook nil + "Invoked on the forwarded letter by \\<mh-folder-mode-map>\\[mh-forward]." + :type 'hook + :group 'mh-hooks + :group 'mh-folder) + (defcustom mh-inc-folder-hook nil "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder." :type 'hook :group 'mh-hooks - :group 'mh-folder) + :group 'mh-inc) (defcustom mh-kill-folder-suppress-prompt-hook '(mh-index-p) "Invoked at the beginning of the \\<mh-folder-mode-map>`\\[mh-kill-folder]' command. @@ -1733,13 +2023,12 @@ t on +inbox and you hit \\<mh-folder-mode-map>`\\[mh-kill-folder]' by accident in the +inbox buffer, you will not be happy." :type 'hook :group 'mh-hooks - :group 'mh-folder) + :group 'mh-show) (defcustom mh-letter-insert-signature-hook nil - "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-insert-signature] command. -Can be used to determine which signature file to use based on message content. -On return, if `mh-signature-file-name' is non-nil that file will be inserted at -the current point in the buffer." + "Invoked after signature has been inserted. +This hook may access the actual name of the file or the function used to +insert the signature with `mh-signature-file-name'." :type 'hook :group 'mh-hooks :group 'mh-letter) @@ -1748,26 +2037,26 @@ the current point in the buffer." "Invoked in `mh-letter-mode' on a new letter." :type 'hook :group 'mh-hooks - :group 'mh-letter) + :group 'mh-sending-mail) (defcustom mh-pick-mode-hook nil "Invoked upon entry to `mh-pick-mode'." :type 'hook :group 'mh-hooks - :group 'mh-folder) + :group 'mh-index) (defcustom mh-quit-hook nil "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits MH-E. See also `mh-before-quit-hook'." :type 'hook :group 'mh-hooks - :group 'mh-folder) + :group 'mh-show) (defcustom mh-refile-msg-hook nil "Invoked after marking each message for refiling." :type 'hook :group 'mh-hooks - :group 'mh-folder) + :group 'mh-show) (defcustom mh-show-hook nil "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message." @@ -1787,44 +2076,13 @@ The variable `mh-seen-list' can be used to obtain the list of messages which will be removed from the unseen sequence." :type 'hook :group 'mh-hooks - :group 'mh-folder) + :group 'mh-show) -;;; Faces - -;;; Faces used in speedbar (:group mh-speed-faces) - -(defface mh-speedbar-folder-face - '((((class color) (background light)) - (:foreground "blue4")) - (((class color) (background dark)) - (:foreground "light blue"))) - "Face used for folders in the speedbar buffer." - :group 'mh-speed-faces) - -(defface mh-speedbar-selected-folder-face - '((((class color) (background light)) - (:foreground "red" :underline t)) - (((class color) (background dark)) - (:foreground "red" :underline t)) - (t (:underline t))) - "Face used for the current folder." - :group 'mh-speed-faces) +;;; Faces (:group 'mh-*-faces + group where faces described) -(defface mh-speedbar-folder-with-unseen-messages-face - '((t (:inherit mh-speedbar-folder-face :bold t))) - "Face used for folders in the speedbar buffer which have unread messages." - :group 'mh-speed-faces) - -(defface mh-speedbar-selected-folder-with-unseen-messages-face - '((t (:inherit mh-speedbar-selected-folder-face :bold t))) - "Face used for the current folder when it has unread messages." - :group 'mh-speed-faces) - - - -;;; Faces used in scan listing (:group mh-folder-faces) +;;; Faces Used in Scan Listing (:group 'mh-folder-faces) (defvar mh-folder-body-face 'mh-folder-body-face "Face for highlighting body text in MH-Folder buffers.") @@ -1962,7 +2220,36 @@ will be removed from the unseen sequence." -;;; Faces used in message display (:group mh-show-faces) +;;; Faces Used in Searching (:group 'mh-index-faces) + +(defvar mh-index-folder-face 'mh-index-folder-face + "Face for highlighting folders in MH-Index buffers.") +(defface mh-index-folder-face + '((((class color) (background light)) + (:foreground "dark green" :bold t)) + (((class color) (background dark)) + (:foreground "indian red" :bold t)) + (t + (:bold t))) + "Face for highlighting folders in MH-Index buffers." + :group 'mh-index-faces) + + + +;;; Faces Used in Message Drafts (:group 'mh-letter-faces) + +(defface mh-letter-header-field-face + '((((class color) (background light)) + (:background "gray90")) + (((class color) (background dark)) + (:background "gray10")) + (t (:bold t))) + "Face for displaying header fields in draft buffers." + :group 'mh-letter-faces) + + + +;;; Faces Used in Message Display (:group 'mh-show-faces) (defvar mh-show-cc-face 'mh-show-cc-face "Face for highlighting cc header fields.") @@ -2002,6 +2289,11 @@ will be removed from the unseen sequence." "Face used to deemphasize unspecified header fields." :group 'mh-show-faces) +(defface mh-show-signature-face + '((t (:italic t))) + "Face for highlighting message signature." + :group 'mh-show-faces) + (defvar mh-show-to-face 'mh-show-to-face "Face for highlighting the To: header field.") (if (boundp 'facemenu-unlisted-faces) @@ -2041,32 +2333,34 @@ The background and foreground is used in the image." -;;; Faces used in indexed searches (:group mh-index-faces) +;;; Faces Used in Speedbar (:group 'mh-speed-faces) -(defvar mh-index-folder-face 'mh-index-folder-face - "Face for highlighting folders in MH-Index buffers.") -(defface mh-index-folder-face +(defface mh-speedbar-folder-face '((((class color) (background light)) - (:foreground "dark green" :bold t)) + (:foreground "blue4")) (((class color) (background dark)) - (:foreground "indian red" :bold t)) - (t - (:bold t))) - "Face for highlighting folders in MH-Index buffers." - :group 'mh-index-faces) - - - -;;; Faces used when composing messages. + (:foreground "light blue"))) + "Face used for folders in the speedbar buffer." + :group 'mh-speed-faces) -(defface mh-letter-header-field-face +(defface mh-speedbar-selected-folder-face '((((class color) (background light)) - (:background "gray90")) + (:foreground "red" :underline t)) (((class color) (background dark)) - (:background "gray10")) - (t (:bold t))) - "Face for displaying header fields in draft buffers." - :group 'mh-letter-faces) + (:foreground "red" :underline t)) + (t (:underline t))) + "Face used for the current folder." + :group 'mh-speed-faces) + +(defface mh-speedbar-folder-with-unseen-messages-face + '((t (:inherit mh-speedbar-folder-face :bold t))) + "Face used for folders in the speedbar buffer which have unread messages." + :group 'mh-speed-faces) + +(defface mh-speedbar-selected-folder-with-unseen-messages-face + '((t (:inherit mh-speedbar-selected-folder-face :bold t))) + "Face used for the current folder when it has unread messages." + :group 'mh-speed-faces) ;;; Local Variables: ;;; indent-tabs-mode: nil diff --git a/lisp/mh-e/mh-e.el b/lisp/mh-e/mh-e.el index e72304c4412..2081d49b6cd 100644 --- a/lisp/mh-e/mh-e.el +++ b/lisp/mh-e/mh-e.el @@ -5,7 +5,7 @@ ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> -;; Version: 7.4.4 +;; Version: 7.82 ;; Keywords: mail ;; This file is part of GNU Emacs. @@ -75,25 +75,21 @@ ;; Original version for Gosling emacs by Brian Reid, Stanford, 1982. ;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985. -;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu -;; Modified by Stephen Gildea 1988. gildea@lcs.mit.edu -;; Maintenance picked up by Bill Wohler <wohler@newt.com> and the -;; SourceForge Crew <http://mh-e.sourceforge.net/>. 2001. +;; Rewritten for GNU Emacs, James Larus, 1985. +;; Modified by Stephen Gildea, 1988. +;; Maintenance picked up by Bill Wohler and the +;; SourceForge Crew <http://mh-e.sourceforge.net/>, 2001. ;;; Code: (provide 'mh-e) -(require 'mh-utils) -(mh-require-cl) - -(defvar recursive-load-depth-limit) -(eval-when (compile load eval) - (if (and (boundp 'recursive-load-depth-limit) - (integerp recursive-load-depth-limit) - (> 50 recursive-load-depth-limit)) - (setq recursive-load-depth-limit 50))) +(eval-when-compile (require 'mh-acros)) +(mh-require-cl) +(require 'mh-utils) +(require 'mh-init) (require 'mh-inc) +(require 'mh-seq) (require 'gnus-util) (require 'easymenu) @@ -101,35 +97,27 @@ (defvar font-lock-auto-fontify) (defvar font-lock-defaults) -(defconst mh-version "7.4.4" "Version number of MH-E.") +(defconst mh-version "7.82" "Version number of MH-E.") ;;; Autoloads (autoload 'Info-goto-node "info") - - -(defvar mh-note-deleted "D" - "String whose first character is used to notate deleted messages.") - -(defvar mh-note-refiled "^" - "String whose first character is used to notate refiled messages.") - -(defvar mh-note-cur "+" - "String whose first character is used to notate the current message.") - (defvar mh-partial-folder-mode-line-annotation "select" "Annotation when displaying part of a folder. The string is displayed after the folder's name. nil for no annotation.") + +;;; Scan Line Formats + ;;; Parameterize MH-E to work with different scan formats. The defaults work ;;; with the standard MH scan listings, in which the first 4 characters on ;;; the line are the message number, followed by two places for notations. -;; The following scan formats are passed to the scan program if the -;; setting of `mh-scan-format-file' above is nil. They are identical -;; except the later one makes use of the nmh `decode' function to -;; decode RFC 2047 encodings. If you just want to change the width of -;; the msg number, use the `mh-set-cmd-note' function. +;; The following scan formats are passed to the scan program if the setting of +;; `mh-scan-format-file' is t. They are identical except the later one makes +;; use of the nmh `decode' function to decode RFC 2047 encodings. If you just +;; want to change the width of the msg number, use the `mh-set-cmd-note' +;; function. (defvar mh-scan-format-mh (concat @@ -150,11 +138,10 @@ This format is identical to the default except that additional hints for fontification have been added to the fifth column (remember that in Emacs, the first column is 0). -The values of the fifth column, in priority order, are: `-' if the -message has been replied to, t if an address on the To: line matches -one of the mailboxes of the current user, `c' if the Cc: line matches, -`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header -is present.") +The values of the fifth column, in priority order, are: `-' if the message has +been replied to, t if an address on the To: line matches one of the +mailboxes of the current user, `c' if the Cc: line matches, `b' if the Bcc: +line matches, and `n' if a non-empty Newsgroups: header is present.") (defvar mh-scan-format-nmh (concat @@ -176,78 +163,94 @@ This format is identical to the default except that additional hints for fontification have been added to the fifth column (remember that in Emacs, the first column is 0). -The values of the fifth column, in priority order, are: `-' if the -message has been replied to, t if an address on the To: line matches -one of the mailboxes of the current user, `c' if the Cc: line matches, -`b' if the Bcc: line matches, and `n' if a non-empty Newsgroups: header -is present.") +The values of the fifth column, in priority order, are: `-' if the message has +been replied to, t if an address on the To: field matches one of the +mailboxes of the current user, `c' if the Cc: field matches, `b' if the Bcc: +field matches, and `n' if a non-empty Newsgroups: field is present.") + +(defvar mh-note-deleted ?D + "Deleted messages are marked by this character. +See also `mh-scan-deleted-msg-regexp'.") + +(defvar mh-note-refiled ?^ + "Refiled messages are marked by this character. +See also `mh-scan-refiled-msg-regexp'.") + +(defvar mh-note-cur ?+ + "The current message (in MH) is marked by this character. +See also `mh-scan-cur-msg-number-regexp'.") (defvar mh-scan-good-msg-regexp "^\\( *[0-9]+\\)[^D^0-9]" - "Regexp specifying the scan lines that are 'good' messages. -The default `mh-folder-font-lock-keywords' expects this expression to contain -at least one parenthesized expression which matches the message number.") + "This regexp specifies the scan lines that are 'good' messages. +Note that the default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least one parenthesized expression which matches the +message number as in the default of \"^\\\\( *[0-9]+\\\\)[^D^0-9]\".") (defvar mh-scan-deleted-msg-regexp "^\\( *[0-9]+\\)D" - "Regexp matching scan lines of deleted messages. -The default `mh-folder-font-lock-keywords' expects this expression to contain -at least one parenthesized expression which matches the message number.") + "This regexp matches deleted messages. +Note that the default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least one parenthesized expression which matches the +message number as in the default of \"^\\\\( *[0-9]+\\\\)D\". +See also `mh-note-deleted'.") (defvar mh-scan-refiled-msg-regexp "^\\( *[0-9]+\\)\\^" - "Regexp matching scan lines of refiled messages. -The default `mh-folder-font-lock-keywords' expects this expression to contain -at least one parenthesized expression which matches the message number.") + "This regexp matches refiled messages. +Note that the default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least one parenthesized expression which matches the +message number as in the default of \"^\\\\( *[0-9]+\\\\)\\\\^\". +See also `mh-note-refiled'.") (defvar mh-scan-valid-regexp "^ *[0-9]" - "Regexp matching scan lines for messages (not error messages).") + "This regexp matches scan lines for messages (not error messages).") (defvar mh-scan-cur-msg-number-regexp "^\\( *[0-9]+\\+\\).*" - "Regexp matching scan line for the current message. -The default `mh-folder-font-lock-keywords' expects this expression to contain -at least one parenthesized expression which matches the message number. -Don't disable this regexp as it's needed by non fontifying functions.") - -(defvar mh-scan-cur-msg-regexp "^\\( *[0-9]+\\+DISABLED.*\\)" - "Regexp matching scan line for the current message. -The default `mh-folder-font-lock-keywords' expects this expression to contain -at least one parenthesized expression which matches the whole line. -To enable this feature, remove the string DISABLED from the regexp.") + "This regexp matches the current message. +Note that the default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least one parenthesized expression which matches the +message number as in the default of \"^\\\\( *[0-9]+\\\\+\\\\).*\". Don't +disable this regexp as it's needed by non-fontifying functions. +See also `mh-note-cur'.") (defvar mh-scan-date-regexp "\\([0-9][0-9]/[0-9][0-9]\\)" - "Regexp matching a valid date in scan lines. -The default `mh-folder-font-lock-keywords' expects this expression to contain -only one parenthesized expression which matches the date field -\(see `mh-scan-format-regexp').") + "This regexp matches a valid date. +Note that the default setting of `mh-folder-font-lock-keywords' expects this +expression to contain only one parenthesized expression which matches the date +field as in the default of \"\\\\([0-9][0-9]/[0-9][0-9]\\\\)\"}. +See also `mh-scan-format-regexp'.") (defvar mh-scan-rcpt-regexp "\\(To:\\)\\(..............\\)" - "Regexp specifying the recipient in scan lines for messages we sent. -The default `mh-folder-font-lock-keywords' expects this expression to contain -two parenthesized expressions. The first is expected to match the To: -that the default scan format file generates. The second is expected to match -the recipient's name.") + "This regexp specifies the recipient in messages you sent. +Note that the default setting of `mh-folder-font-lock-keywords' +expects this expression to contain two parenthesized expressions. The +first is expected to match the `To:' that the default scan format +file generates. The second is expected to match the recipient's name +as in the default of \"\\\\(To:\\\\)\\\\(..............\\\\)\".") (defvar mh-scan-body-regexp "\\(<<\\([^\n]+\\)?\\)" - "Regexp matching the message body beginning displayed in scan lines. -The default `mh-folder-font-lock-keywords' expects this expression to contain -at least one parenthesized expression which matches the body text.") + "This regexp matches the message body fragment displayed in scan lines. +Note that the default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least one parenthesized expression which matches the +body text as in the default of \"\\\\(<<\\\\([^\\n]+\\\\)?\\\\)\".") (defvar mh-scan-subject-regexp - ;;"^ *[0-9]+........[ ]*...................\\([Rr][Ee]:\\s-*\\)*\\([^<\n]*\\)" "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" - "*Regexp matching the subject string in MH folder mode. -The default `mh-folder-font-lock-keywords' expects this expression to contain -at least tree parenthesized expressions. The first is expected to match the Re: -string, if any. The second matches an optional bracketed number after Re, -such as in Re[2]: and the third is expected to match the subject line itself.") + "This regexp matches the subject. +Note that the default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least three parenthesized expressions. The first is +expected to match the `Re:' string, if any. The second matches an optional +bracketed number after `Re:', such as in `Re[2]:' (and is thus a +sub-expression of the first expression) and the third is expected to match +the subject line itself as in the default of \"^ *[0-9]+........[ ]*...................\\\\([Rr][Ee]\\\\(\\\\\\=[[0-9]+\\\\]\\\\)?:\\\\s-*\\\\)*\\\\([^<\\n]*\\\\)\".") (defvar mh-scan-format-regexp (concat "\\([bct]\\)" mh-scan-date-regexp " *\\(..................\\)") - "Regexp matching the output of scan. -The default value is based upon the default values of either -`mh-scan-format-mh' or `mh-scan-format-nmh'. -The default `mh-folder-font-lock-keywords' expects this expression to contain -at least three parenthesized expressions. The first should match the -fontification hint, the second is found in `mh-scan-date-regexp', and the -third should match the user name.") + "This regexp matches the output of scan. +Note that the default setting of `mh-folder-font-lock-keywords' expects this +expression to contain at least three parenthesized expressions. The first +should match the fontification hint, the second is found in +`mh-scan-date-regexp', and the third should match the user name as in the +default of \"(concat \"\\\\([bct]\\\\)\" mh-scan-date-regexp + \"*\\\\(..................\\\\)\")\".") @@ -279,10 +282,7 @@ third should match the user name.") ;; scan font-lock name (list mh-scan-format-regexp '(1 mh-folder-date-face) - '(3 mh-folder-scan-format-face)) - ;; Current message line - (list mh-scan-cur-msg-regexp - '(1 mh-folder-cur-msg-face prepend t))) + '(3 mh-folder-scan-format-face))) "Regexp keywords used to fontify the MH-Folder buffer.") (defvar mh-scan-cmd-note-width 1 @@ -356,46 +356,6 @@ This column will only ever have spaces in it.") ;; Fontifify unseen mesages in bold. -(defvar mh-folder-unseen-seq-name nil - "Name of unseen sequence. -The default for this is provided by the function `mh-folder-unseen-seq-name' -On nmh systems.") - -(defun mh-folder-unseen-seq-name () - "Provide name of unseen sequence from mhparam." - (or mh-progs (mh-find-path)) - (save-excursion - (let ((unseen-seq-name "unseen")) - (with-temp-buffer - (unwind-protect - (progn - (call-process (expand-file-name "mhparam" mh-progs) - nil '(t t) nil "-component" "Unseen-Sequence") - (goto-char (point-min)) - (if (re-search-forward "Unseen-Sequence: \\(.*\\)$" nil t) - (setq unseen-seq-name (match-string 1)))))) - unseen-seq-name))) - -(defun mh-folder-unseen-seq-list () - "Return a list of unseen message numbers for current folder." - (if (not mh-folder-unseen-seq-name) - (setq mh-folder-unseen-seq-name (mh-folder-unseen-seq-name))) - (cond - ((not mh-folder-unseen-seq-name) - nil) - (t - (let ((folder mh-current-folder)) - (save-excursion - (with-temp-buffer - (unwind-protect - (progn - (call-process (expand-file-name "mark" mh-progs) - nil '(t t) nil - folder "-seq" mh-folder-unseen-seq-name - "-list") - (goto-char (point-min)) - (sort (mh-read-msg-list) '<))))))))) - (defmacro mh-generate-sequence-font-lock (seq prefix face) "Generate the appropriate code to fontify messages in SEQ. PREFIX is used to generate unique names for the variables and functions @@ -492,6 +452,8 @@ is done highlighting.") ;Rememeber original notation that ;is overwritten by `mh-note-seq'. +(defvar mh-colors-available-flag nil) ;Are colors available? + ;;; Macros and generic functions: (defun mh-mapc (function list) @@ -503,7 +465,7 @@ is done highlighting.") (defun mh-scan-format () "Return the output format argument for the scan program." (if (equal mh-scan-format-file t) - (list "-format" (if mh-nmh-flag + (list "-format" (if (mh-variant-p 'nmh 'mu-mh) (list (mh-update-scan-format mh-scan-format-nmh mh-cmd-note)) (list (mh-update-scan-format @@ -519,7 +481,7 @@ is done highlighting.") (defun mh-rmail (&optional arg) "Inc(orporate) new mail with MH. Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E, -the Emacs front end to the MH mail system." +the Emacs interface to the MH mail system." (interactive "P") (mh-find-path) (if arg @@ -532,7 +494,7 @@ the Emacs front end to the MH mail system." (defun mh-nmail (&optional arg) "Check for new mail in inbox folder. Scan an MH folder if ARG is non-nil. This function is an entry point to MH-E, -the Emacs front end to the MH mail system." +the Emacs interface to the MH mail system." (interactive "P") (mh-find-path) ; init mh-inbox (if arg @@ -616,6 +578,7 @@ Do not call this function from outside MH-E; use \\[mh-rmail] instead." (setq folder mh-inbox)) (let ((threading-needed-flag nil)) (let ((config (current-window-configuration))) + (delete-other-windows) (cond ((not (get-buffer folder)) (mh-make-folder folder) (setq threading-needed-flag mh-show-threads-flag) @@ -659,25 +622,26 @@ last undeleted message then pause for a second after printing message." (if wait-after-complaining-flag (sit-for 1))))) (defun mh-folder-from-address () - "Determine folder name from address in From field. -Takes the address in the From: header field, and returns one of: + "Derive folder name from sender. + +The name of the folder is derived as follows: - a) The folder name associated with the address in the alist - `mh-default-folder-list'. If the `Check Recipient' boolean - is set, then the `mh-default-folder-list' addresses are - checked against the recipient instead of the originator - (making possible to use this feature for mailing lists). - The first match found in `mh-default-folder-list' is used. + a) The folder name associated with the first address found in the list + `mh-default-folder-list' is used. Each element in this list contains a + `Check Recipient' item. If this item is turned on, then the address is + checked against the recipient instead of the sender. This is useful for + mailing lists. - b) The address' corresponding alias from the user's personal - aliases file prefixed by `mh-default-folder-prefix'. + b) An alias prefixed by `mh-default-folder-prefix' corresponding to the + address is used. The prefix is used to prevent clutter in your mail + directory. -Returns nil if the address was not found in either place or if the variable -`mh-default-folder-must-exist-flag' is nil and the folder does not exist." +Return nil if a folder name was not derived, or if the variable +`mh-default-folder-must-exist-flag' is t and the folder does not exist." ;; Loop for all entries in mh-default-folder-list (save-restriction (goto-char (point-min)) - (re-search-forward "\n\n" nil t) + (re-search-forward "\n\n" nil 'limit) (narrow-to-region (point-min) (point)) (let ((to/cc (concat (or (message-fetch-field "to") "") ", " (or (message-fetch-field "cc") ""))) @@ -715,25 +679,24 @@ Returns nil if the address was not found in either place or if the variable "Prompt the user for a folder in which the message should be filed. The folder is returned as a string. -If `mh-default-folder-for-message-function' is a function then the message -being refiled is yanked into a temporary buffer and the function is called to -intelligently guess where the message is to be refiled. - -Otherwise, a default folder name is generated by `mh-folder-from-address'." +The default folder name is generated by the option +`mh-default-folder-for-message-function' if it is non-nil or +`mh-folder-from-address'." (mh-prompt-for-folder "Destination" - (let ((refile-file (mh-msg-filename (mh-get-msg-num t)))) - (save-excursion - (set-buffer (get-buffer-create mh-temp-buffer)) - (erase-buffer) - (insert-file-contents refile-file) - (or (and mh-default-folder-for-message-function - (let ((buffer-file-name refile-file)) - (funcall mh-default-folder-for-message-function))) - (mh-folder-from-address) - (and (eq 'refile (car mh-last-destination-folder)) - (symbol-name (cdr mh-last-destination-folder))) - ""))) + (let ((refile-file (ignore-errors (mh-msg-filename (mh-get-msg-num t))))) + (if (null refile-file) "" + (save-excursion + (set-buffer (get-buffer-create mh-temp-buffer)) + (erase-buffer) + (insert-file-contents refile-file) + (or (and mh-default-folder-for-message-function + (let ((buffer-file-name refile-file)) + (funcall mh-default-folder-for-message-function))) + (mh-folder-from-address) + (and (eq 'refile (car mh-last-destination-folder)) + (symbol-name (cdr mh-last-destination-folder))) + "")))) t)) (defun mh-refile-msg (range folder &optional dont-update-last-destination-flag) @@ -872,7 +835,9 @@ are skipped." (setq count (1- count))) (not (car unread-sequence))) (message "No more unread messages")) - (t (mh-goto-msg (car unread-sequence)))))) + (t (loop for msg in unread-sequence + when (mh-goto-msg msg t) return nil + finally (message "No more unread messages")))))) (defun mh-goto-next-button (backward-flag &optional criterion) "Search for next button satisfying criterion. @@ -1090,7 +1055,7 @@ interactive use." (if (not (mh-outstanding-commands-p)) (mh-set-folder-modified-p nil))) -;;;###mh-autoload + (defun mh-folder-line-matches-show-buffer-p () "Return t if the message under point in folder-mode is in the show buffer. Return nil in any other circumstance (no message under point, no show buffer, @@ -1123,7 +1088,6 @@ compiled then macro expansion happens at compile time." (defun mh-version () "Display version information about MH-E and the MH mail handling system." (interactive) - (mh-find-progs) (set-buffer (get-buffer-create mh-info-buffer)) (erase-buffer) ;; MH-E version. @@ -1140,19 +1104,12 @@ compiled then macro expansion happens at compile time." ;; Emacs version. (insert (emacs-version) "\n\n") ;; MH version. - (let ((help-start (point))) - (condition-case err-data - (mh-exec-cmd-output "inc" nil (if mh-nmh-flag "-version" "-help")) - (file-error (insert (mapconcat 'concat (cdr err-data) ": ") "\n"))) - (goto-char help-start) - (if mh-nmh-flag - (search-forward "inc -- " nil t) - (search-forward "version: " nil t)) - (delete-region help-start (point))) - (goto-char (point-max)) - (insert " mh-progs:\t" mh-progs "\n" - " mh-lib:\t" mh-lib "\n" - " mh-lib-progs:\t" mh-lib-progs "\n\n") + (if mh-variant-in-use + (insert mh-variant-in-use "\n" + " mh-progs:\t" mh-progs "\n" + " mh-lib:\t" mh-lib "\n" + " mh-lib-progs:\t" mh-lib-progs "\n\n") + (insert "No MH variant detected\n")) ;; Linux version. (condition-case () (call-process "uname" nil t nil "-a") @@ -1202,7 +1159,7 @@ used to avoid problems in corner cases involving folders whose names end with a (defun mh-folder-size-flist (folder) "Find size of FOLDER using `flist'." (with-temp-buffer - (call-process (expand-file-name "flist" mh-progs) nil t nil + (call-process (expand-file-name "flist" mh-progs) nil t nil "-showzero" "-norecurse" folder "-sequence" (symbol-name mh-unseen-seq)) (goto-char (point-min)) (multiple-value-bind (folder unseen total) @@ -1236,6 +1193,7 @@ regardless of the size of the `mh-large-folder' variable." (let ((config (current-window-configuration)) (current-buffer (current-buffer)) (threaded-view-flag mh-show-threads-flag)) + (delete-other-windows) (save-excursion (when (get-buffer folder) (set-buffer folder) @@ -1258,12 +1216,11 @@ regardless of the size of the `mh-large-folder' variable." (mh-toggle-threads)) (mh-index-data (mh-index-insert-folder-headers))) - (unless mh-showing-mode (delete-other-windows)) (unless (eq current-buffer (current-buffer)) (setq mh-previous-window-config config))) nil) -;;;###mh-autoload + (defun mh-update-sequences () "Update MH's Unseen-Sequence and current folder and message. Flush MH-E's state out to MH. The message at the cursor becomes current." @@ -1334,7 +1291,7 @@ arguments, after the message has been refiled." (mh-exec-cmd "refile" (mh-get-msg-num t) "-link" "-src" mh-current-folder (symbol-name folder)) - (message "Message not copied."))) + (message "Message not copied"))) (t (mh-set-folder-modified-p t) (cond ((null (assoc folder mh-refile-list)) @@ -1381,7 +1338,9 @@ With optional argument COUNT, COUNT-1 unread messages are skipped." (setq count (1- count))) (not (car unread-sequence))) (message "No more unread messages")) - (t (mh-goto-msg (car unread-sequence)))))) + (t (loop for msg in unread-sequence + when (mh-goto-msg msg t) return nil + finally (message "No more unread messages")))))) (defun mh-set-scan-mode () "Display the scan listing buffer, but do not show a message." @@ -1472,12 +1431,12 @@ Make it the current folder." ["Go to First Message" mh-first-msg t] ["Go to Last Message" mh-last-msg t] ["Go to Message by Number..." mh-goto-msg t] - ["Modify Message" mh-modify] + ["Modify Message" mh-modify t] ["Delete Message" mh-delete-msg (mh-get-msg-num nil)] ["Refile Message" mh-refile-msg (mh-get-msg-num nil)] - ["Undo Delete/Refile" mh-undo t] - ["Process Delete/Refile" mh-execute-commands - (or mh-refile-list mh-delete-list)] + ["Undo Delete/Refile" mh-undo (mh-outstanding-commands-p)] + ["Execute Delete/Refile" mh-execute-commands + (mh-outstanding-commands-p)] "--" ["Compose a New Message" mh-send t] ["Reply to Message..." mh-reply (mh-get-msg-num nil)] @@ -1501,7 +1460,7 @@ Make it the current folder." ["Incorporate New Mail" mh-inc-folder t] ["Toggle Show/Folder" mh-toggle-showing t] ["Execute Delete/Refile" mh-execute-commands - (or mh-refile-list mh-delete-list)] + (mh-outstanding-commands-p)] ["Rescan Folder" mh-rescan-folder t] ["Thread Folder" mh-toggle-threads (not (memq 'unthread mh-view-ops))] @@ -1541,6 +1500,12 @@ is used in previous versions and XEmacs." (defvar tool-bar-map) (defvar desktop-save-buffer)) ;Emacs 21.4 +;; Register mh-folder-mode as supporting which-function-mode... +(load "which-func" t t) +(when (and (boundp 'which-func-modes) + (not (member 'mh-folder-mode which-func-modes))) + (push 'mh-folder-mode which-func-modes)) + (define-derived-mode mh-folder-mode fundamental-mode "MH-Folder" "Major MH-E mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map> @@ -1548,16 +1513,49 @@ You can show the message the cursor is pointing to, and step through the messages. Messages can be marked for deletion or refiling into another folder; these commands are executed all at once with a separate command. -A prefix argument (\\[universal-argument]) to delete, refile, list, or undo -applies the action to a message sequence. If `transient-mark-mode', -is non-nil, the action is applied to the region. - Options that control this mode can be changed with \\[customize-group]; specify the \"mh\" group. In particular, please see the `mh-scan-format-file' option if you wish to modify scan's format. When a folder is visited, the hook `mh-folder-mode-hook' is run. +Ranges +====== +Many commands that operate on individual messages, such as `mh-forward' or +`mh-refile-msg' take a RANGE argument. This argument can be used in several +ways. + +If you provide the prefix argument (\\[universal-argument]) to these commands, +then you will be prompted for the message range. This can be any legal MH +range which can include messages, sequences, and the abbreviations (described +in the mh(1) man page): + +<num1>-<num2> + Indicates all messages in the range <num1> to <num2>, inclusive. The range + must be nonempty. + +`<num>:N' +`<num>:+N' +`<num>:-N' + Up to N messages beginning with (or ending with) message num. Num may be + any of the pre-defined symbols: first, prev, cur, next or last. + +`first:N' +`prev:N' +`next:N' +`last:N' + The first, previous, next or last messages, if they exist. + +`all' + All of the messages. + +For example, a range that shows all of these things is `1 2 3 5-10 last:5 +unseen'. + +If the option `transient-mark-mode' is set to t and you set a region in the +MH-Folder buffer, then the MH-E command will perform the operation on all +messages in that region. + \\{mh-folder-mode-map}" (make-local-variable 'font-lock-defaults) @@ -1565,10 +1563,15 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run. (make-local-variable 'desktop-save-buffer) (setq desktop-save-buffer t) (mh-make-local-vars + 'mh-colors-available-flag (mh-colors-available-p) + ; Do we have colors available 'mh-current-folder (buffer-name) ; Name of folder, a string 'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs 'mh-folder-filename ; e.g. "/usr/foobar/Mail/inbox/" (file-name-as-directory (mh-expand-file-name (buffer-name))) + 'mh-display-buttons-for-inline-parts-flag + mh-display-buttons-for-inline-parts-flag ; Allow for display of buttons to + ; be toggled. 'mh-arrow-marker (make-marker) ; Marker where arrow is displayed 'overlay-arrow-position nil ; Allow for simultaneous display in 'overlay-arrow-string ">" ; different MH-E buffers. @@ -1597,6 +1600,8 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run. 'mh-sequence-notation-history (make-hash-table) ; Remember what is overwritten by ; mh-note-seq. + 'imenu-create-index-function 'mh-index-create-imenu-index + ; Setup imenu support 'mh-previous-window-config nil) ; Previous window configuration (mh-remove-xemacs-horizontal-scrollbar) (setq truncate-lines t) @@ -1620,6 +1625,26 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run. font-lock-auto-fontify) (turn-on-font-lock))) ; Force font-lock in XEmacs. +(defun mh-toggle-mime-buttons () + "Toggle display of buttons for inline MIME parts." + (interactive) + (setq mh-display-buttons-for-inline-parts-flag + (not mh-display-buttons-for-inline-parts-flag)) + (mh-show nil t)) + +(defun mh-colors-available-p () + "Check if colors are available in the Emacs being used." + (or mh-xemacs-flag + (let ((color-cells + (or (ignore-errors (mh-funcall-if-exists display-color-cells)) + (ignore-errors (mh-funcall-if-exists + x-display-color-cells))))) + (and (numberp color-cells) (>= color-cells 8))))) + +(defun mh-colors-in-use-p () + "Check if colors are being used in the folder buffer." + (and mh-colors-available-flag font-lock-mode)) + (defun mh-make-local-vars (&rest pairs) "Initialize local variables according to the variable-value PAIRS." @@ -1631,7 +1656,11 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run. (defun mh-restore-desktop-buffer (desktop-buffer-file-name desktop-buffer-name desktop-buffer-misc) - "Restore an MH folder buffer specified in a desktop file." + "Restore an MH folder buffer specified in a desktop file. +When desktop creates a buffer, DESKTOP-BUFFER-FILE-NAME holds the file name to +visit, DESKTOP-BUFFER-NAME holds the desired buffer name, and +DESKTOP-BUFFER-MISC holds a list of miscellaneous info used by the +`desktop-buffer-handlers' functions." (mh-find-path) (mh-visit-folder desktop-buffer-name) (current-buffer)) @@ -1641,6 +1670,8 @@ When a folder is visited, the hook `mh-folder-mode-hook' is run. If the optional argument DONT-EXEC-PENDING is non-nil then pending deletes and refiles aren't carried out. Return in the folder's buffer." + (when (stringp range) + (setq range (delete "" (split-string range "[ \t\n]")))) (cond ((null (get-buffer folder)) (mh-make-folder folder)) (t @@ -1693,7 +1724,9 @@ If UPDATE, append the scan lines, otherwise replace." (goto-char scan-start) (cond ((looking-at "scan: no messages in") (keep-lines mh-scan-valid-regexp)) ; Flush random scan lines - ((looking-at "scan: bad message list ") + ((looking-at (if (mh-variant-p 'mu-mh) + "scan: message set .* does not exist" + "scan: bad message list ")) (keep-lines mh-scan-valid-regexp)) ((looking-at "scan: ")) ; Keep error messages (t @@ -1869,46 +1902,21 @@ in what is now stored in the buffer-local variable `mh-mode-line-annotation'." ("")))))) (mh-logo-display)))) -;;; XXX: Remove this function, if no one uses it any more... -(defun mh-unmark-all-headers (remove-all-flags) - "Remove all '+' flags from the folder listing. -With non-nil argument REMOVE-ALL-FLAGS, remove all 'D', '^' and '%' flags too. -Optimized for speed (i.e., no regular expressions). - -This function is deprecated. Use `mh-remove-all-notation' instead." - (save-excursion - (let ((case-fold-search nil) - (last-line (1- (point-max))) - char) - (mh-first-msg) - (while (<= (point) last-line) - (forward-char mh-cmd-note) - (setq char (following-char)) - (if (or (and remove-all-flags - (or (= char (aref mh-note-deleted 0)) - (= char (aref mh-note-refiled 0)))) - (= char (aref mh-note-cur 0))) - (progn - (delete-char 1) - (insert " "))) - (if remove-all-flags - (progn - (forward-char 1) - (if (= (following-char) (aref mh-note-seq 0)) - (progn - (delete-char 1) - (insert " "))))) - (forward-line))))) - (defun mh-add-sequence-notation (msg internal-seq-flag) "Add sequence notation to the MSG on the current line. -If INTERNAL-SEQ-FLAG is non-nil, then just remove text properties from the -current line, so that font-lock would automatically refontify it." +If INTERNAL-SEQ-FLAG is non-nil, then refontify the scan line if font-lock is +turned on." (with-mh-folder-updating (t) (save-excursion (beginning-of-line) (if internal-seq-flag - (mh-notate nil nil mh-cmd-note) + (progn + ;; Change the buffer so that if transient-mark-mode is active + ;; and there is an active region it will get deactivated as in + ;; the case of user sequences. + (mh-notate nil nil mh-cmd-note) + (when font-lock-mode + (font-lock-fontify-region (point) (line-end-position)))) (forward-char (1+ mh-cmd-note)) (let ((stack (gethash msg mh-sequence-notation-history))) (setf (gethash msg mh-sequence-notation-history) @@ -1930,7 +1938,11 @@ If ALL is non-nil, then all sequence marks on the scan line are removed." (while (and all (cdr stack)) (setq stack (cdr stack))) (when stack - (mh-notate nil (car stack) (1+ mh-cmd-note))) + (save-excursion + (beginning-of-line) + (forward-char (1+ mh-cmd-note)) + (delete-char 1) + (insert (car stack)))) (setf (gethash msg mh-sequence-notation-history) (cdr stack)))))) (defun mh-remove-cur-notation () @@ -1953,7 +1965,7 @@ If ALL is non-nil, then all sequence marks on the scan line are removed." (mh-remove-sequence-notation msg nil t)) (clrhash mh-sequence-notation-history))) -;;;###mh-autoload + (defun mh-goto-cur-msg (&optional minimal-changes-flag) "Position the cursor at the current message. When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't @@ -2102,7 +2114,10 @@ with no arguments, after the unseen sequence is updated." (defun mh-outstanding-commands-p () "Return non-nil if there are outstanding deletes or refiles." - (or mh-delete-list mh-refile-list)) + (save-excursion + (when (eq major-mode 'mh-show-mode) + (set-buffer mh-show-folder-buffer)) + (or mh-delete-list mh-refile-list))) (defun mh-coalesce-msg-list (messages) "Given a list of MESSAGES, return a list of message number ranges. @@ -2223,7 +2238,7 @@ numbers, a sequence, a region in a cons cell. If nil all messages are notated." "Return non-nil if NAME is the name of an internal MH-E sequence." (or (memq name mh-internal-seqs) (eq name mh-unseen-seq) - (and mh-tick-seq (eq name mh-tick-seq)) + (and (mh-colors-in-use-p) mh-tick-seq (eq name mh-tick-seq)) (eq name mh-previous-seq) (mh-folder-name-p name))) @@ -2264,6 +2279,15 @@ change." (when (and (eq sequence mh-unseen-seq) (mh-speed-flists-active-p)) (apply #'mh-speed-flists t folders-changed))))) +(defun mh-catchup (range) + "Delete RANGE from the `mh-unseen-seq' sequence. + +Check the document of `mh-interactive-range' to see how RANGE is read in +interactive use." + (interactive (list (mh-interactive-range "Catchup" + (cons (point-min) (point-max))))) + (mh-delete-msg-from-seq range mh-unseen-seq)) + (defun mh-delete-a-msg-from-seq (msg sequence internal-flag) "Delete MSG from SEQUENCE. If INTERNAL-FLAG is non-nil, then do not inform MH of the change." @@ -2291,23 +2315,6 @@ Signals an error if SEQ is an illegal name." "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))) -(defun mh-map-over-seqs (function seq-list) - "Apply FUNCTION to each sequence in SEQ-LIST. -The sequence name and the list of messages are passed as arguments." - (while seq-list - (funcall function - (mh-seq-name (car seq-list)) - (mh-seq-msgs (car seq-list))) - (setq seq-list (cdr seq-list)))) - -(defun mh-notate-if-in-one-seq (msg character offset seq) - "Notate MSG. -The CHARACTER is placed at the given OFFSET from the beginning of the listing. -The notation is performed if the MSG is only in SEQ." - (let ((in-seqs (mh-seq-containing-msg msg nil))) - (if (and (eq seq (car in-seqs)) (null (cdr in-seqs))) - (mh-notate msg character offset)))) - (defun mh-seq-containing-msg (msg &optional include-internal-flag) "Return a list of the sequences containing MSG. If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." @@ -2341,6 +2348,7 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." "'" mh-toggle-tick "," mh-header-display "." mh-alt-show + ";" mh-toggle-mh-decode-mime-flag ">" mh-write-msg-to-file "?" mh-help "E" mh-extract-rejected-mail @@ -2362,7 +2370,6 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." "g" mh-goto-msg "i" mh-inc-folder "k" mh-delete-subject-or-thread - "l" mh-print-msg "m" mh-alt-send "n" mh-next-undeleted-msg "\M-n" mh-next-unread-msg @@ -2382,6 +2389,7 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." "?" mh-prefix-help "'" mh-index-ticked-messages "S" mh-sort-folder + "c" mh-catchup "f" mh-alt-visit-folder "i" mh-index-search "k" mh-kill-folder @@ -2402,6 +2410,17 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." "b" mh-junk-blacklist "w" mh-junk-whitelist) +(gnus-define-keys (mh-ps-print-map "P" mh-folder-mode-map) + "?" mh-prefix-help + "A" mh-ps-print-toggle-mime + "C" mh-ps-print-toggle-color + "F" mh-ps-print-toggle-faces + "M" mh-ps-print-toggle-mime + "f" mh-ps-print-msg-file + "l" mh-print-msg + "p" mh-ps-print-msg + "s" mh-ps-print-msg-show) + (gnus-define-keys (mh-sequence-map "S" mh-folder-mode-map) "'" mh-narrow-to-tick "?" mh-prefix-help @@ -2446,8 +2465,10 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." (gnus-define-keys (mh-mime-map "K" mh-folder-mode-map) "?" mh-prefix-help "a" mh-mime-save-parts + "e" mh-display-with-external-viewer "i" mh-folder-inline-mime-part "o" mh-folder-save-mime-part + "t" mh-toggle-mime-buttons "v" mh-folder-toggle-mime-part "\t" mh-next-button [backtab] mh-prev-button @@ -2477,13 +2498,17 @@ If INCLUDE-INTERNAL-FLAG non-nil, include MH-E internal sequences in list." (defvar mh-help-messages '((nil "[i]nc, [.]show, [,]show all, [n]ext, [p]revious,\n" "[d]elete, [o]refile, e[x]ecute,\n" - "[s]end, [r]eply.\n" + "[s]end, [r]eply,\n" + "[;]toggle MIME decoding.\n" "Prefix characters:\n [F]older, [S]equence, [J]unk, MIME [K]eys," "\n [T]hread, [/]limit, e[X]tract, [D]igest, [I]nc spools.") (?F "[l]ist; [v]isit folder;\n" "[n]ew messages; [']ticked messages; [s]earch; [i]ndexed search;\n" "[p]ack; [S]ort; [r]escan; [k]ill") + (?P "PS [p]rint message; [l]non-PS print;\n" + "PS Print [s]how window, message to [f]ile;\n" + "Toggle printing of [M]IME parts, [C]olor, [F]aces") (?S "[p]ut message in sequence, [n]arrow, [']narrow to ticked, [w]iden,\n" "[s]equences, [l]ist,\n" "[d]elete message from sequence, [k]ill sequence") diff --git a/lisp/mh-e/mh-funcs.el b/lisp/mh-e/mh-funcs.el index 46201860e2a..ef745f4c06f 100644 --- a/lisp/mh-e/mh-funcs.el +++ b/lisp/mh-e/mh-funcs.el @@ -1,6 +1,6 @@ ;;; mh-funcs.el --- MH-E functions not everyone will use right away -;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995, 2001, 02, 03, 2004 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -34,6 +34,8 @@ ;;; Code: +(eval-when-compile (require 'mh-acros)) +(mh-require-cl) (require 'mh-e) ;;; Customization @@ -45,11 +47,13 @@ prefix argument. Normally default arguments to sortm are specified in the MH profile. For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.") +;;; Scan Line Formats + (defvar mh-note-copied "C" - "String whose first character is used to notate copied messages.") + "Copied messages are marked by this character.") (defvar mh-note-printed "P" - "String whose first character is used to notate printed messages.") + "Messages that have been printed are marked by this character.") ;;; Functions @@ -233,60 +237,6 @@ Otherwise just send the message's body without the headers." (mh-recenter 0))) ;;;###mh-autoload -(defun mh-print-msg (range) - "Print RANGE on printer. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use. - -The variable `mh-lpr-command-format' is used to generate the print command. -The messages are formatted by mhl. See the variable `mhl-formfile'." - (interactive (list (mh-interactive-range "Print"))) - (message "Printing...") - (let (msgs) - ;; Gather message numbers and add them to "printed" sequence. - (mh-iterate-on-range msg range - (mh-add-msgs-to-seq msg 'printed t) - (mh-notate nil mh-note-printed mh-cmd-note) - (push msg msgs)) - (setq msgs (nreverse msgs)) - ;; Print scan listing if we have more than one message. - (if (> (length msgs) 1) - (let* ((msgs-string - (mapconcat 'identity (mh-list-to-string - (mh-coalesce-msg-list msgs)) " ")) - (lpr-command - (format mh-lpr-command-format - (cond ((listp range) - (format "Folder: %s, Messages: %s" - mh-current-folder msgs-string)) - ((symbolp range) - (format "Folder: %s, Sequence: %s" - mh-current-folder range))))) - (scan-command - (format "scan %s | %s" msgs-string lpr-command))) - (if mh-print-background-flag - (mh-exec-cmd-daemon shell-file-name nil "-c" scan-command) - (call-process shell-file-name nil nil nil "-c" scan-command)))) - ;; Print the messages - (dolist (msg msgs) - (let* ((mhl-command (format "%s %s %s" - (expand-file-name "mhl" mh-lib-progs) - (if mhl-formfile - (format " -form %s" mhl-formfile) - "") - (mh-msg-filename msg))) - (lpr-command - (format mh-lpr-command-format - (format "%s/%s" mh-current-folder msg))) - (print-command - (format "%s | %s" mhl-command lpr-command))) - (if mh-print-background-flag - (mh-exec-cmd-daemon shell-file-name nil "-c" print-command) - (call-process shell-file-name nil nil nil "-c" print-command))))) - (message "Printing...done")) - -;;;###mh-autoload (defun mh-sort-folder (&optional extra-args) "Sort the messages in the current folder by date. Calls the MH program sortm to do the work. @@ -307,9 +257,8 @@ argument EXTRA-ARGS is given." (mh-index-data (mh-index-insert-folder-headers))))) ;;;###mh-autoload -(defun mh-undo-folder (&rest ignore) - "Undo all pending deletes and refiles in current folder. -Argument IGNORE is deprecated." +(defun mh-undo-folder () + "Undo all pending deletes and refiles in current folder." (interactive) (cond ((or mh-do-not-confirm-flag (yes-or-no-p "Undo all commands in folder? ")) @@ -320,10 +269,7 @@ Argument IGNORE is deprecated." (with-mh-folder-updating (nil) (mh-remove-all-notation))) (t - (message "Commands not undone.") - ;; Remove by 2003-06-30 if nothing seems amiss. XXX - ;; (sit-for 2) - ))) + (message "Commands not undone")))) ;;;###mh-autoload (defun mh-store-msg (directory) @@ -413,11 +359,15 @@ Default directory is the last directory used, or initially the value of ;;;###mh-autoload (defun mh-help () - "Display cheat sheet for the MH-Folder commands in minibuffer." + "Display cheat sheet for the MH-E commands." (interactive) - (mh-ephem-message - (substitute-command-keys - (mapconcat 'identity (cdr (assoc nil mh-help-messages)) "")))) + (with-electric-help + (function + (lambda () + (insert + (substitute-command-keys + (mapconcat 'identity (cdr (assoc nil mh-help-messages)) "")))) + mh-help-buffer))) ;;;###mh-autoload (defun mh-prefix-help () @@ -430,9 +380,14 @@ Default directory is the last directory used, or initially the value of ;; from the recent keys. (let* ((keys (recent-keys)) (prefix-char (elt keys (- (length keys) 2)))) - (mh-ephem-message - (substitute-command-keys - (mapconcat 'identity (cdr (assoc prefix-char mh-help-messages)) ""))))) + (with-electric-help + (function + (lambda () + (insert + (substitute-command-keys + (mapconcat 'identity + (cdr (assoc prefix-char mh-help-messages)) ""))))) + mh-help-buffer))) (provide 'mh-funcs) diff --git a/lisp/mh-e/mh-gnus.el b/lisp/mh-e/mh-gnus.el index 0a893efa3c9..b850c8fdc43 100644 --- a/lisp/mh-e/mh-gnus.el +++ b/lisp/mh-e/mh-gnus.el @@ -1,6 +1,6 @@ ;;; mh-gnus.el --- Make MH-E compatible with installed version of Gnus. -;; Copyright (C) 2003 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. ;; Author: Satyaki Das <satyaki@theforce.stanford.edu> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -34,6 +34,7 @@ (load "mm-uu" t t) ; Non-fatal dependency (load "mailcap" t t) ; Non-fatal dependency (load "smiley" t t) ; Non-fatal dependency +(load "mailabbrev" t t) (defmacro mh-defun-compat (function arg-list &rest body) "This is a macro to define functions which are not defined. @@ -74,12 +75,28 @@ BODY." (put-text-property 0 (length (car handle)) parameter value (car handle)))) +;; Copy of function from mm-view.el +(mh-defun-compat mm-inline-text-vcard (handle) + (let (buffer-read-only) + (mm-insert-inline + handle + (concat "\n-- \n" + (ignore-errors + (if (fboundp 'vcard-pretty-print) + (vcard-pretty-print (mm-get-part handle)) + (vcard-format-string + (vcard-parse-string (mm-get-part handle) + 'vcard-standard-filter)))))))) + +;; Function from mm-decode.el used in PGP messages. Just define it with older +;; gnus to avoid compiler warning. +(mh-defun-compat mm-possibly-verify-or-decrypt (parts ctl) + nil) + ;; Copy of original macro is in mm-decode.el (mh-defmacro-compat mm-handle-multipart-ctl-parameter (handle parameter) `(get-text-property 0 ,parameter (car ,handle))) -(mh-do-in-xemacs (defvar default-enable-multibyte-characters)) - ;; Copy of original function in mm-decode.el (mh-defun-compat mm-readable-p (handle) "Say whether the content of HANDLE is readable." @@ -134,10 +151,23 @@ BODY." file))) (mm-save-part-to-file handle file)))) +(defun mh-mm-text-html-renderer () + "Find the renderer gnus is using to display text/html MIME parts." + (or (and (boundp 'mm-inline-text-html-renderer) mm-inline-text-html-renderer) + (and (boundp 'mm-text-html-renderer) mm-text-html-renderer))) + +(defun mh-mail-abbrev-make-syntax-table () + "Call `mail-abbrev-make-syntax-table' if available." + (when (fboundp 'mail-abbrev-make-syntax-table) + (mail-abbrev-make-syntax-table))) + (provide 'mh-gnus) + ;;; Local Variables: ;;; no-byte-compile: t ;;; no-update-autoloads: t +;;; indent-tabs-mode: nil +;;; sentence-end-double-space: nil ;;; End: ;; arch-tag: 1e3638af-cad3-4c69-8427-bc8eb6e5e4fa diff --git a/lisp/mh-e/mh-identity.el b/lisp/mh-e/mh-identity.el index f4edc7a2087..be385ad09e6 100644 --- a/lisp/mh-e/mh-identity.el +++ b/lisp/mh-e/mh-identity.el @@ -39,47 +39,50 @@ ;;; Code: - -(require 'mh-utils) +(eval-when-compile (require 'mh-acros)) (mh-require-cl) - -(eval-when (compile load eval) - (defvar mh-comp-loaded nil) - (unless mh-comp-loaded - (setq mh-comp-loaded t) - (require 'mh-comp))) ;Since we do this on sending +(require 'mh-comp) (autoload 'mml-insert-tag "mml") +(defvar mh-identity-pgg-default-user-id nil + "Holds the GPG key ID to be used by pgg.el. +This is normally set as part of an Identity in `mh-identity-list'.") +(make-variable-buffer-local 'mh-identity-pgg-default-user-id) + ;;;###mh-autoload (defun mh-identity-make-menu () - "Build (or rebuild) the Identity menu (e.g. after the list is modified)." - (when (and mh-identity-list (boundp 'mh-letter-mode-map)) - (easy-menu-define mh-identity-menu mh-letter-mode-map - "mh-e identity menu" - (append - '("Identity") - ;; Dynamically render :type corresponding to `mh-identity-list' - ;; e.g.: - ;; ["home" (mh-insert-identity "home") - ;; :style radio :active (not (equal mh-identity-local "home")) - ;; :selected (equal mh-identity-local "home")] - '(["Insert Auto Fields" (mh-insert-auto-fields) mh-auto-fields-list] - "--") - (mapcar (function - (lambda (arg) - `[,arg (mh-insert-identity ,arg) :style radio - :active (not (equal mh-identity-local ,arg)) - :selected (equal mh-identity-local ,arg)])) - (mapcar 'car mh-identity-list)) - '("--" - ["none" (mh-insert-identity "none") mh-identity-local] - ["Set Default for Session" - (setq mh-identity-default mh-identity-local) t] - ["Save as Default" - (customize-save-variable - 'mh-identity-default mh-identity-local) t] - ))))) + "Build the Identity menu. +This should be called any time `mh-identity-list' or `mh-auto-fields-list' +change." + (easy-menu-define mh-identity-menu mh-letter-mode-map + "MH-E identity menu" + (append + '("Identity") + ;; Dynamically render :type corresponding to `mh-identity-list' + ;; e.g.: + ;; ["Home" (mh-insert-identity "Home") + ;; :style radio :active (not (equal mh-identity-local "Home")) + ;; :selected (equal mh-identity-local "Home")] + '(["Insert Auto Fields" + (mh-insert-auto-fields) mh-auto-fields-list] + "--") + + (mapcar (function + (lambda (arg) + `[,arg (mh-insert-identity ,arg) :style radio + :selected (equal mh-identity-local ,arg)])) + (mapcar 'car mh-identity-list)) + '(["None" + (mh-insert-identity "None") :style radio + :selected (not mh-identity-local)] + "--" + ["Set Default for Session" + (setq mh-identity-default mh-identity-local) t] + ["Save as Default" + (customize-save-variable 'mh-identity-default mh-identity-local) t] + ["Customize Identities" (customize-variable 'mh-identity-list) t] + )))) ;;;###mh-autoload (defun mh-identity-list-set (symbol value) @@ -97,21 +100,36 @@ customization). This is called after 'customize is used to alter (defun mh-header-field-delete (field value-only) "Delete FIELD in the mail header, or only its value if VALUE-ONLY is t. Return t if anything is deleted." - (when (mh-goto-header-field field) - (if (not value-only) - (beginning-of-line) - (forward-char)) - (delete-region (point) - (progn (mh-header-field-end) - (if (not value-only) (forward-char 1)) - (point))) - t)) + (let ((field-colon (if (string-match "^.*:$" field) + field + (concat field ":")))) + (when (mh-goto-header-field field-colon) + (if (not value-only) + (beginning-of-line) + (forward-char)) + (delete-region (point) + (progn (mh-header-field-end) + (if (not value-only) (forward-char 1)) + (point))) + t))) (defvar mh-identity-signature-start nil "Marker for the beginning of a signature inserted by `mh-insert-identity'.") (defvar mh-identity-signature-end nil "Marker for the end of a signature inserted by `mh-insert-identity'.") +(defun mh-identity-field-handler (field) + "Return the handler for a FIELD or nil if none set. +The field name is downcased. If the FIELD begins with the character +`:', then it must have a special handler defined in +`mh-identity-handlers', else return an error since it is not a legal +message header." + (or (cdr (assoc (downcase field) mh-identity-handlers)) + (and (eq (aref field 0) ?:) + (error (format "Field %s - unknown mh-identity-handler" field))) + (cdr (assoc ":default" mh-identity-handlers)) + 'mh-identity-handler-default)) + ;;;###mh-autoload (defun mh-insert-identity (identity) "Insert proper fields for given IDENTITY. @@ -120,7 +138,7 @@ Edit the `mh-identity-list' variable to define identity." (list (completing-read "Identity: " (if mh-identity-local - (cons '("none") + (cons '("None") (mapcar 'list (mapcar 'car mh-identity-list))) (mapcar 'list (mapcar 'car mh-identity-list))) nil t))) @@ -129,83 +147,135 @@ Edit the `mh-identity-list' variable to define identity." (when mh-identity-local (let ((pers-list (cadr (assoc mh-identity-local mh-identity-list)))) (while pers-list - (let ((field (concat (caar pers-list) ":"))) - (cond - ((string-equal "signature:" field) - (when (and (boundp 'mh-identity-signature-start) - (markerp mh-identity-signature-start)) - (goto-char mh-identity-signature-start) - (forward-char -1) - (delete-region (point) mh-identity-signature-end))) - ((mh-header-field-delete field nil)))) + (let* ((field (caar pers-list)) + (handler (mh-identity-field-handler field))) + (funcall handler field 'remove)) (setq pers-list (cdr pers-list))))) ;; Then insert the replacement - (when (not (equal "none" identity)) + (when (not (equal "None" identity)) (let ((pers-list (cadr (assoc identity mh-identity-list)))) (while pers-list - (let ((field (concat (caar pers-list) ":")) - (value (cdar pers-list))) - (cond - ;; No value, remove field - ((or (not value) - (string= value "")) - (mh-header-field-delete field nil)) - ;; Existing field, replace - ((mh-header-field-delete field t) - (insert value)) - ;; Handle "signature" special case. Insert file or call function. - ((and (string-equal "signature:" field) - (or (and (stringp value) - (file-readable-p value)) - (fboundp value))) - (goto-char (point-max)) - (if (not (looking-at "^$")) - (insert "\n")) - (insert "\n") - (save-restriction - (narrow-to-region (point) (point)) - (set (make-local-variable 'mh-identity-signature-start) - (make-marker)) - (set-marker mh-identity-signature-start (point)) - (cond - ;; If MIME composition done, insert signature at the end as - ;; an inline MIME part. - ((mh-mhn-directive-present-p) - (insert "#\n" "Content-Description: Signature\n")) - ((mh-mml-directive-present-p) - (mml-insert-tag 'part 'type "text/plain" - 'disposition "inline" - 'description "Signature"))) - (if (stringp value) - (insert-file-contents value) - (funcall value)) - (goto-char (point-min)) - (when (not (re-search-forward "^--" nil t)) - (cond ((mh-mhn-directive-present-p) - (forward-line 2)) - ((mh-mml-directive-present-p) - (forward-line 1))) - (insert "-- \n")) - (set (make-local-variable 'mh-identity-signature-end) - (make-marker)) - (set-marker mh-identity-signature-end (point-max)))) - ;; Handle "From" field differently, adding it at the beginning. - ((string-equal "From:" field) - (goto-char (point-min)) - (insert "From: " value "\n")) - ;; Skip empty signature (Can't remove what we don't know) - ((string-equal "signature:" field)) - ;; Other field, add at end - (t ;Otherwise, add the end. - (goto-char (point-min)) - (mh-goto-header-end 0) - (mh-insert-fields field value)))) + (let* ((field (caar pers-list)) + (value (cdar pers-list)) + (handler (mh-identity-field-handler field))) + (funcall handler field 'add value)) (setq pers-list (cdr pers-list)))))) ;; Remember what is in use in this buffer - (if (equal "none" identity) + (if (equal "None" identity) (setq mh-identity-local nil) (setq mh-identity-local identity))) +;;;###mh-autoload +(defun mh-identity-handler-gpg-identity (field action &optional value) + "For FIELD \"pgg-default-user-id\", process for ACTION 'remove or 'add. +The buffer-local variable `mh-identity-pgg-default-user-id' is set to VALUE +when action 'add is selected." + (cond + ((or (equal action 'remove) + (not value) + (string= value "")) + (setq mh-identity-pgg-default-user-id nil)) + ((equal action 'add) + (setq mh-identity-pgg-default-user-id value)))) + +;;;###mh-autoload +(defun mh-identity-handler-signature (field action &optional value) + "For FIELD \"signature\", process headers for ACTION 'remove or 'add. +The VALUE is added." + (cond + ((equal action 'remove) + (when (and (markerp mh-identity-signature-start) + (markerp mh-identity-signature-end)) + (delete-region mh-identity-signature-start + mh-identity-signature-end))) + (t + ;; Insert "signature". Nil value means to use `mh-signature-file-name'. + (when (not (mh-signature-separator-p)) ;...unless already present + (goto-char (point-max)) + (save-restriction + (narrow-to-region (point) (point)) + (if (null value) + (mh-insert-signature) + (mh-insert-signature value)) + (set (make-local-variable 'mh-identity-signature-start) + (point-min-marker)) + (set-marker-insertion-type mh-identity-signature-start t) + (set (make-local-variable 'mh-identity-signature-end) + (point-max-marker))))))) + +(defvar mh-identity-attribution-verb-start nil + "Marker for the beginning of the attribution verb.") +(defvar mh-identity-attribution-verb-end nil + "Marker for the end of the attribution verb.") + +;;;###mh-autoload +(defun mh-identity-handler-attribution-verb (field action &optional value) + "For FIELD \"attribution_verb\", process headers for ACTION 'remove or 'add. +The VALUE is added." + (when (and (markerp mh-identity-attribution-verb-start) + (markerp mh-identity-attribution-verb-end)) + (delete-region mh-identity-attribution-verb-start + mh-identity-attribution-verb-end) + (goto-char mh-identity-attribution-verb-start) + (cond + ((equal action 'remove) ; Replace with default + (mh-identity-insert-attribution-verb nil)) + (t ; Insert attribution verb. + (mh-identity-insert-attribution-verb value))))) + +;;;###mh-autoload +(defun mh-identity-insert-attribution-verb (value) + "Insert VALUE as attribution verb, setting up delimiting markers. +If VALUE is nil, use `mh-extract-from-attribution-verb'." + (save-restriction + (narrow-to-region (point) (point)) + (if (null value) + (insert mh-extract-from-attribution-verb) + (insert value)) + (set (make-local-variable 'mh-identity-attribution-verb-start) + (point-min-marker)) + (set-marker-insertion-type mh-identity-attribution-verb-start t) + (set (make-local-variable 'mh-identity-attribution-verb-end) + (point-max-marker)))) + +(defun mh-identity-handler-default (field action top &optional value) + "For FIELD, process mh-identity headers for ACTION 'remove or 'add. +if TOP is non-nil, add the field and it's VALUE at the top of the header, else +add it at the bottom of the header." + (let ((field-colon (if (string-match "^.*:$" field) + field + (concat field ":")))) + (cond + ((equal action 'remove) + (mh-header-field-delete field-colon nil)) + (t + (cond + ;; No value, remove field + ((or (not value) + (string= value "")) + (mh-header-field-delete field-colon nil)) + ;; Existing field, replace + ((mh-header-field-delete field-colon t) + (insert value)) + ;; Other field, add at end or top + (t + (goto-char (point-min)) + (if (not top) + (mh-goto-header-end 0)) + (insert field-colon " " value "\n"))))))) + +;;;###mh-autoload +(defun mh-identity-handler-top (field action &optional value) + "For FIELD, process mh-identity headers for ACTION 'remove or 'add. +If the field wasn't present, the VALUE is added at the top of the header." + (mh-identity-handler-default field action t value)) + +;;;###mh-autoload +(defun mh-identity-handler-bottom (field action &optional value) + "For FIELD, process mh-identity headers for ACTION 'remove or 'add. +If the field wasn't present, the VALUE is added at the bottom of the header." + (mh-identity-handler-default field action nil value)) + (provide 'mh-identity) ;;; Local Variables: diff --git a/lisp/mh-e/mh-inc.el b/lisp/mh-e/mh-inc.el index 1c052b140bd..42ca018506f 100644 --- a/lisp/mh-e/mh-inc.el +++ b/lisp/mh-e/mh-inc.el @@ -1,6 +1,6 @@ ;;; mh-inc.el --- MH-E `inc' and separate mail spool handling ;; -;; Copyright (C) 2003 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. ;; Author: Peter S. Galbraith <psg@debian.org> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -34,7 +34,8 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'mh-acros)) +(mh-require-cl) (defvar mh-inc-spool-map (make-sparse-keymap) "Keymap for MH-E's mh-inc-spool commands.") @@ -46,7 +47,8 @@ '(lambda () (interactive) (if mh-inc-spool-map-help - (mh-ephem-message (substring mh-inc-spool-map-help 0 -1)) + (let ((mh-help-messages (list (list nil mh-inc-spool-map-help)))) + (mh-help)) (mh-ephem-message "There are no keys defined yet. Customize `mh-inc-spool-list'")))) diff --git a/lisp/mh-e/mh-index.el b/lisp/mh-e/mh-index.el index 734ce938616..91eed420e2e 100644 --- a/lisp/mh-e/mh-index.el +++ b/lisp/mh-e/mh-index.el @@ -31,7 +31,6 @@ ;;; swish-e ;;; mairix ;;; namazu -;;; glimpse ;;; grep ;;; ;;; (2) To use this package, you first have to build an index. Please read @@ -43,7 +42,7 @@ ;;; Code: -(require 'mh-utils) +(eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-e) (require 'mh-mime) @@ -66,8 +65,6 @@ mh-mairix-regexp-builder) (namazu mh-namazu-binary mh-namazu-execute-search mh-namazu-next-result nil) - (glimpse - mh-glimpse-binary mh-glimpse-execute-search mh-glimpse-next-result nil) (pick mh-pick-binary mh-pick-execute-search mh-pick-next-result mh-pick-regexp-builder) @@ -200,7 +197,8 @@ This function should only be called in the appropriate index folder buffer." (call-process "rm" nil nil nil (format "%s%s/%s" mh-user-path (substring mh-current-folder 1) msg)) - (remhash omsg (gethash ofolder mh-index-data)))) + (when (gethash ofolder mh-index-data) + (remhash omsg (gethash ofolder mh-index-data))))) (t (setf (gethash msg mh-index-msg-checksum-map) checksum) (when origin-map @@ -301,7 +299,8 @@ list of messages in that sequence." (pair (gethash checksum mh-index-checksum-origin-map)) (ofolder (car pair)) (omsg (cdr pair))) - (loop for seq in (gethash omsg (gethash ofolder seq-hash)) + (loop for seq in (ignore-errors + (gethash omsg (gethash ofolder seq-hash))) do (if (assoc seq seq-list) (push msg (cdr (assoc seq seq-list))) (push (list seq msg) seq-list))))) @@ -374,7 +373,6 @@ index for each program: - `mh-swish-execute-search' - `mh-mairix-execute-search' - `mh-namazu-execute-search' - - `mh-glimpse-execute-search' If none of these programs are present then we use pick. If desired grep can be used instead. Details about these methods can be found in: @@ -436,7 +434,7 @@ This has the effect of renaming already present X-MHE-Checksum headers." (save-excursion (mh-exec-cmd-quiet nil "rmf" buffer-name)) (mh-exec-cmd-quiet nil "folder" "-create" "-fast" buffer-name) (setq index-folder buffer-name)) - (setq index-folder (mh-index-new-folder index-folder))) + (setq index-folder (mh-index-new-folder index-folder search-regexp))) (let ((folder-path (format "%s%s" mh-user-path (substring folder 1))) (folder-results-map (make-hash-table :test #'equal)) @@ -587,13 +585,6 @@ PROC is used to convert the value to actual data." mh-previous-window-config) (error "No search terms")))) -(defun mh-replace-string (old new) - "Replace all occurrences of OLD with NEW in the current buffer." - (goto-char (point-min)) - (let ((case-fold-search t)) - (while (search-forward old nil t) - (replace-match new t t)))) - ;;;###mh-autoload (defun mh-index-parse-search-regexp (input-string) "Construct parse tree for INPUT-STRING. @@ -739,28 +730,48 @@ results." "Check if MSG exists in FOLDER." (file-exists-p (format "%s%s/%s" mh-user-path (substring folder 1) msg))) -(defun mh-index-new-folder (name) - "Create and return an MH folder name based on NAME. -If the folder NAME already exists then check if NAME<2> exists. If it doesn't -then it is created and returned. Otherwise try NAME<3>. This is repeated till -we find a new folder name." +(defun mh-index-new-folder (name search-regexp) + "Return a folder name based on NAME for search results of SEARCH-REGEXP. + +If folder NAME already exists and was generated for the same SEARCH-REGEXP +then it is reused. + +Otherwise if the folder NAME was generated from a different search then check +if NAME<2> can be used. Otherwise try NAME<3>. This is repeated till we find a +new folder name. + +If the folder returned doesn't exist then it is created." (unless (mh-folder-name-p name) (error "The argument should be a valid MH folder name")) - (let ((chosen-name name)) - (block unique-name - (unless (mh-folder-exists-p name) - (return-from unique-name)) - (loop for index from 2 - do (let ((new-name (format "%s<%s>" name index))) - (unless (mh-folder-exists-p new-name) - (setq chosen-name new-name) - (return-from unique-name))))) + (let ((chosen-name + (loop for i from 1 + for candidate = (if (equal i 1) name (format "%s<%s>" name i)) + when (or (not (mh-folder-exists-p candidate)) + (equal (mh-index-folder-search-regexp candidate) + search-regexp)) + return candidate))) + ;; Do pending refiles/deletes... + (when (get-buffer chosen-name) + (mh-process-or-undo-commands chosen-name)) + ;; Recreate folder... + (save-excursion (mh-exec-cmd-quiet nil "rmf" chosen-name)) (mh-exec-cmd-quiet nil "folder" "-create" "-fast" chosen-name) (mh-remove-from-sub-folders-cache chosen-name) (when (boundp 'mh-speed-folder-map) (mh-speed-add-folder chosen-name)) chosen-name)) +(defun mh-index-folder-search-regexp (folder) + "If FOLDER was created by a index search, return the search regexp. +Return nil if FOLDER doesn't exist or the .mhe_index file is garbled." + (ignore-errors + (with-temp-buffer + (insert-file-contents + (format "%s%s/%s" mh-user-path (substring folder 1) mh-index-data-file)) + (goto-char (point-min)) + (forward-list 3) + (cadr (read (current-buffer)))))) + ;;;###mh-autoload (defun mh-index-insert-folder-headers () "Annotate the search results with original folder names." @@ -777,8 +788,27 @@ we find a new folder name." (insert (if last-folder "\n" "") current-folder "\n") (setq last-folder current-folder)) (forward-line)) - (when cur-msg (mh-goto-msg cur-msg t)) - (set-buffer-modified-p old-buffer-modified-flag))) + (when cur-msg + (mh-notate-cur) + (mh-goto-msg cur-msg t)) + (set-buffer-modified-p old-buffer-modified-flag)) + (mh-index-create-imenu-index)) + +;;;###mh-autoload +(defun mh-index-create-imenu-index () + "Create alist of folder names and positions in index folder buffers." + (save-excursion + (setq which-func-mode t) + (let ((alist ())) + (goto-char (point-min)) + (while (re-search-forward "^+" nil t) + (save-excursion + (beginning-of-line) + (push (cons (buffer-substring-no-properties + (point) (line-end-position)) + (set-marker (make-marker) (point))) + alist))) + (setq imenu--index-alist (nreverse alist))))) ;;;###mh-autoload (defun mh-index-group-by-folder () @@ -837,23 +867,6 @@ list of messages originally from that folder." folder (loop for x being the hash-keys of (gethash folder mh-index-data) when (mh-msg-exists-p x folder) collect x))))) -;;;###mh-autoload -(defun mh-index-update-unseen (msg) - "Remove counterpart of MSG in source folder from `mh-unseen-seq'. -Also `mh-update-unseen' is called in the original folder, if we have it open." - (let* ((checksum (gethash msg mh-index-msg-checksum-map)) - (folder-msg-pair (gethash checksum mh-index-checksum-origin-map)) - (orig-folder (car folder-msg-pair)) - (orig-msg (cdr folder-msg-pair))) - (when (mh-index-match-checksum orig-msg orig-folder checksum) - (when (get-buffer orig-folder) - (save-excursion - (set-buffer orig-folder) - (unless (member orig-msg mh-seen-list) (push orig-msg mh-seen-list)) - (mh-update-unseen))) - (mh-exec-cmd-daemon "mark" #'ignore orig-folder (format "%s" orig-msg) - "-sequence" (symbol-name mh-unseen-seq) "-del")))) - (defun mh-index-match-checksum (msg folder checksum) "Check if MSG in FOLDER has X-MHE-Checksum header value of CHECKSUM." (with-temp-buffer @@ -973,90 +986,6 @@ update the source folder buffer if present." -;; Glimpse interface - -(defvar mh-glimpse-binary (executable-find "glimpse")) -(defvar mh-glimpse-directory ".glimpse") - -;;;###mh-autoload -(defun mh-glimpse-execute-search (folder-path search-regexp) - "Execute glimpse and read the results. - -In the examples below, replace /home/user/Mail with the path to your MH -directory. - -First create the directory /home/user/Mail/.glimpse. Then create the file -/home/user/Mail/.glimpse/.glimpse_exclude with the following contents: - - */.* - */#* - */,* - */*~ - ^/home/user/Mail/.glimpse - ^/home/user/Mail/mhe-index - -If there are any directories you would like to ignore, append lines like the -following to .glimpse_exclude: - - ^/home/user/Mail/scripts - -You do not want to index the folders that hold the results of your searches -since they tend to be ephemeral and the original messages are indexed anyway. -The configuration file above assumes that the results are found in sub-folders -of `mh-index-folder' which is +mhe-index by default. - -Use the following command line to generate the glimpse index. Run this -daily from cron: - - glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail - -FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." - (set-buffer (get-buffer-create mh-index-temp-buffer)) - (erase-buffer) - (call-process mh-glimpse-binary nil '(t nil) nil - ;(format "-%s" fuzz) - "-i" "-y" - "-H" (format "%s%s" mh-user-path mh-glimpse-directory) - "-F" (format "^%s" folder-path) - search-regexp) - (goto-char (point-min))) - -(defun mh-glimpse-next-result () - "Read the next result. -Parse it and return the message folder, message index and the match. If no -other matches left then return nil. If the current record is invalid return -'error." - (prog1 - (block nil - (when (eobp) - (return nil)) - (let ((eol-pos (line-end-position)) - (bol-pos (line-beginning-position)) - folder-start msg-end) - (goto-char bol-pos) - (unless (search-forward mh-user-path eol-pos t) - (return 'error)) - (setq folder-start (point)) - (unless (search-forward ": " eol-pos t) - (return 'error)) - (let ((match (buffer-substring-no-properties (point) eol-pos))) - (forward-char -2) - (setq msg-end (point)) - (unless (search-backward "/" folder-start t) - (return 'error)) - (list (format "+%s" (buffer-substring-no-properties - folder-start (point))) - (let ((val (ignore-errors (read-from-string - (buffer-substring-no-properties - (1+ (point)) msg-end))))) - (if (and (consp val) (integerp (car val))) - (car val) - (return 'error))) - match)))) - (forward-line))) - - - ;; Pick interface (defvar mh-index-pick-folder) @@ -1319,16 +1248,12 @@ then the folders are searched recursively. All parameters ARGS are ignored." ;;;###mh-autoload (defun mh-index-sequenced-messages (folders sequence) "Display messages from FOLDERS in SEQUENCE. -By default the folders specified by `mh-index-new-messages-folders' are -searched. With a prefix argument, enter a space-separated list of folders, or -nothing to search all folders. - -Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the -function searches for in each of the FOLDERS. With a prefix argument, enter a -sequence to use." +All messages in the sequence you provide from the folders in +`mh-index-new-messages-folders' are listed. With a prefix argument, enter a +space-separated list of folders, or nothing to search all folders." (interactive (list (if current-prefix-arg - (split-string (read-string "Search folder(s) [all]? ")) + (split-string (read-string "Search folder(s): [all] ")) mh-index-new-messages-folders) (mh-read-seq-default "Search" nil))) (unless sequence (setq sequence mh-unseen-seq)) @@ -1367,26 +1292,26 @@ sequence to use." ;;;###mh-autoload (defun mh-index-new-messages (folders) "Display unseen messages. -All messages in the `unseen' sequence from FOLDERS are displayed. -By default the folders specified by `mh-index-new-messages-folders' -are searched. With a prefix argument, enter a space-separated list of -folders, or nothing to search all folders." +If you use a program such as `procmail' to use `rcvstore' to file your +incoming mail automatically, you can display new, unseen, messages using this +command. All messages in the `unseen' sequence from the folders in +`mh-index-new-messages-folders' are listed. With a prefix argument, enter a +space-separated list of FOLDERS, or nothing to search all folders." (interactive (list (if current-prefix-arg - (split-string (read-string "Search folder(s) [all]? ")) + (split-string (read-string "Search folder(s): [all] ")) mh-index-new-messages-folders))) (mh-index-sequenced-messages folders mh-unseen-seq)) ;;;###mh-autoload (defun mh-index-ticked-messages (folders) "Display ticked messages. -All messages in the `tick' sequence from FOLDERS are displayed. -By default the folders specified by `mh-index-ticked-messages-folders' -are searched. With a prefix argument, enter a space-separated list of -folders, or nothing to search all folders." +All messages in `mh-tick-seq' from the folders in +`mh-index-ticked-messages-folders' are listed. With a prefix argument, enter a +space-separated list of FOLDERS, or nothing to search all folders." (interactive (list (if current-prefix-arg - (split-string (read-string "Search folder(s) [all]? ")) + (split-string (read-string "Search folder(s): [all] ")) mh-index-ticked-messages-folders))) (mh-index-sequenced-messages folders mh-tick-seq)) diff --git a/lisp/mh-e/mh-init.el b/lisp/mh-e/mh-init.el new file mode 100644 index 00000000000..a975b882128 --- /dev/null +++ b/lisp/mh-e/mh-init.el @@ -0,0 +1,308 @@ +;;; mh-init.el --- MH-E initialization. + +;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. + +;; Author: Peter S. Galbraith <psg@debian.org> +;; Maintainer: Bill Wohler <wohler@newt.com> +;; Keywords: mail +;; See: mh-e.el + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Sets up the MH variant (currently nmh or MH). +;; +;; Users may customize `mh-variant' to switch between available variants. +;; Available MH variants are described in the variable `mh-variants'. +;; Developers may check which variant is currently in use with the +;; variable `mh-variant-in-use' or the function `mh-variant-p'. + +;;; Change Log: + +;;; Code: + +(eval-when-compile (require 'mh-acros)) +(mh-require-cl) +(require 'mh-utils) + +;;; Set for local environment: +;;; mh-progs and mh-lib used to be set in paths.el, which tried to +;;; figure out at build time which of several possible directories MH +;;; was installed into. But if you installed MH after building Emacs, +;;; this would almost certainly be wrong, so now we do it at run time. + +(defvar mh-progs nil + "Directory containing MH commands, such as inc, repl, and rmm.") + +(defvar mh-lib nil + "Directory containing the MH library. +This directory contains, among other things, the components file.") + +(defvar mh-lib-progs nil + "Directory containing MH helper programs. +This directory contains, among other things, the mhl program.") + +(defvar mh-flists-present-flag nil + "Non-nil means that we have `flists'.") + +;;;###autoload +(put 'mh-progs 'risky-local-variable t) +;;;###autoload +(put 'mh-lib 'risky-local-variable t) +;;;###autoload +(put 'mh-lib-progs 'risky-local-variable t) + +(defvar mh-variant-in-use nil + "The MH variant currently in use; a string with variant and version number. +This differs from `mh-variant' when the latter is set to `autodetect'.") + +;;;###mh-autoload +(defun mh-variant-set (variant) + "Set the MH variant to VARIANT. +Sets `mh-progs', `mh-lib', `mh-lib-progs' and `mh-flists-present-flag'. +If the VARIANT is `autodetect', then first try nmh, then MH and finally +GNU mailutils." + (interactive + (list (completing-read + "MH Variant: " + (mapcar (lambda (x) (list (car x))) (mh-variants)) + nil t))) + (let ((valid-list (mapcar (lambda (x) (car x)) (mh-variants)))) + (cond + ((eq variant 'none)) + ((eq variant 'autodetect) + (cond + ((mh-variant-set-variant 'nmh) + (message "%s installed as MH variant" mh-variant-in-use)) + ((mh-variant-set-variant 'mh) + (message "%s installed as MH variant" mh-variant-in-use)) + ((mh-variant-set-variant 'mu-mh) + (message "%s installed as MH variant" mh-variant-in-use)) + (t + (message "No MH variant found on the system!")))) + ((member variant valid-list) + (when (not (mh-variant-set-variant variant)) + (message "Warning: %s variant not found. Autodetecting..." variant) + (mh-variant-set 'autodetect))) + (t + (message "Unknown variant. Use %s" + (mapconcat '(lambda (x) (format "%s" (car x))) + mh-variants " or ")))))) + +(defun mh-variant-set-variant (variant) + "Setup the system variables for the MH variant named VARIANT. +If VARIANT is a string, use that key in the variable `mh-variants'. +If VARIANT is a symbol, select the first entry that matches that variant." + (cond + ((stringp variant) ;e.g. "nmh 1.1-RC1" + (when (assoc variant mh-variants) + (let* ((alist (cdr (assoc variant mh-variants))) + (lib-progs (cadr (assoc 'mh-lib-progs alist))) + (lib (cadr (assoc 'mh-lib alist))) + (progs (cadr (assoc 'mh-progs alist))) + (flists (cadr (assoc 'flists alist)))) + ;;(set-default mh-variant variant) + (setq mh-x-mailer-string nil + mh-flists-present-flag flists + mh-lib-progs lib-progs + mh-lib lib + mh-progs progs + mh-variant-in-use variant)))) + ((symbolp variant) ;e.g. 'nmh (pick the first match) + (loop for variant-list in mh-variants + when (eq variant (cadr (assoc 'variant (cdr variant-list)))) + return (let* ((version (car variant-list)) + (alist (cdr variant-list)) + (lib-progs (cadr (assoc 'mh-lib-progs alist))) + (lib (cadr (assoc 'mh-lib alist))) + (progs (cadr (assoc 'mh-progs alist))) + (flists (cadr (assoc 'flists alist)))) + ;;(set-default mh-variant flavor) + (setq mh-x-mailer-string nil + mh-flists-present-flag flists + mh-lib-progs lib-progs + mh-lib lib + mh-progs progs + mh-variant-in-use version) + t))))) + +;;;###mh-autoload +(defun mh-variant-p (&rest variants) + "Return t if variant is any of VARIANTS. +Currently known variants are 'MH, 'nmh, and 'mu-mh." + (let ((variant-in-use + (cadr (assoc 'variant (assoc mh-variant-in-use mh-variants))))) + (not (null (member variant-in-use variants))))) + +(defvar mh-sys-path + '("/usr/local/nmh/bin" ; nmh default + "/usr/local/bin/mh/" + "/usr/local/mh/" + "/usr/bin/mh/" ; Ultrix 4.2, Linux + "/usr/new/mh/" ; Ultrix < 4.2 + "/usr/contrib/mh/bin/" ; BSDI + "/usr/pkg/bin/" ; NetBSD + "/usr/local/bin/" + "/usr/local/bin/mu-mh/" ; GNU mailutils - default + "/usr/bin/mu-mh/") ; GNU mailutils - packaged + "List of directories to search for variants of the MH variant. +The list `exec-path' is searched in addition to this list. +There's no need for users to modify this list. Instead add extra +directories to the customizable variable `mh-path'.") + +(defcustom mh-path nil + "*List of directories to search for variants of the MH variant. +The directories will be searched for `mhparam' in addition to directories +listed in `mh-sys-path' and `exec-path'." + :group 'mh + :type '(repeat (directory))) + +(defvar mh-variants nil + "List describing known MH variants. +Created by the function `mh-variants'") + +(defun mh-variant-mh-info (dir) + "Return info for MH variant in DIR assuming a temporary buffer is setup." + ;; MH does not have the -version option. + ;; Its version number is included in the output of `-help' as: + ;; + ;; version: MH 6.8.4 #2[UCI] (burrito) of Fri Jan 15 20:01:39 EST 1999 + ;; options: [ATHENA] [BIND] [DUMB] [LIBLOCKFILE] [LOCALE] [MAILGROUP] [MHE] + ;; [MHRC] [MIME] [MORE='"/usr/bin/sensible-pager"'] [NLINK_HACK] + ;; [NORUSERPASS] [OVERHEAD] [POP] [POPSERVICE='"pop-3"'] [RENAME] + ;; [RFC1342] [RPATHS] [RPOP] [SENDMTS] [SMTP] [SOCKETS] + ;; [SPRINTFTYPE=int] [SVR4] [SYS5] [SYS5DIR] [TERMINFO] + ;; [TYPESIG=void] [UNISTD] [UTK] [VSPRINTF] + (let ((mhparam (expand-file-name "mhparam" dir))) + (when (and (file-exists-p mhparam) (file-executable-p mhparam)) + (erase-buffer) + (call-process mhparam nil '(t nil) nil "-help") + (goto-char (point-min)) + (when (search-forward-regexp "version: MH \\(\\S +\\)" nil t) + (let ((version (format "MH %s" (match-string 1)))) + (erase-buffer) + (call-process mhparam nil '(t nil) nil "libdir") + (goto-char (point-min)) + (when (search-forward-regexp "^.*$" nil t) + (let ((libdir (match-string 0))) + `(,version + (variant mh) + (mh-lib-progs ,libdir) + (mh-lib ,libdir) + (mh-progs ,dir) + (flists nil))))))))) + +(defun mh-variant-mu-mh-info (dir) + "Return info for GNU mailutils variant in DIR. +This assumes that a temporary buffer is setup." + ;; 'mhparam -version' output: + ;; mhparam (GNU mailutils 0.3.2) + (let ((mhparam (expand-file-name "mhparam" dir))) + (when (and (file-exists-p mhparam) (file-executable-p mhparam)) + (erase-buffer) + (call-process mhparam nil '(t nil) nil "-version") + (goto-char (point-min)) + (when (search-forward-regexp "mhparam (\\(GNU [Mm]ailutils \\S +\\))" + nil t) + (let ((version (match-string 1))) + (erase-buffer) + (call-process mhparam nil '(t nil) nil "libdir" "etcdir") + (goto-char (point-min)) + (when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t) + (let ((libdir (match-string 1))) + (goto-char (point-min)) + (when (search-forward-regexp + "^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t) + (let ((etcdir (match-string 1)) + (flists (file-exists-p (expand-file-name "flists" dir)))) + `(,version + (variant mu-mh) + (mh-lib-progs ,libdir) + (mh-lib ,etcdir) + (mh-progs ,dir) + (flists ,flists))))))))))) + +(defun mh-variant-nmh-info (dir) + "Return info for nmh variant in DIR assuming a temporary buffer is setup." + ;; `mhparam -version' outputs: + ;; mhparam -- nmh-1.1-RC1 [compiled on chaak at Fri Jun 20 11:03:28 PDT 2003] + (let ((mhparam (expand-file-name "mhparam" dir))) + (when (and (file-exists-p mhparam) (file-executable-p mhparam)) + (erase-buffer) + (call-process mhparam nil '(t nil) nil "-version") + (goto-char (point-min)) + (when (search-forward-regexp "mhparam -- nmh-\\(\\S +\\)" nil t) + (let ((version (format "nmh %s" (match-string 1)))) + (erase-buffer) + (call-process mhparam nil '(t nil) nil "libdir" "etcdir") + (goto-char (point-min)) + (when (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" nil t) + (let ((libdir (match-string 1))) + (goto-char (point-min)) + (when (search-forward-regexp + "^etcdir:\\s-\\(\\S-+\\)\\s-*$" nil t) + (let ((etcdir (match-string 1)) + (flists (file-exists-p (expand-file-name "flists" dir)))) + `(,version + (variant nmh) + (mh-lib-progs ,libdir) + (mh-lib ,etcdir) + (mh-progs ,dir) + (flists ,flists))))))))))) + +(defun mh-variant-info (dir) + "Return MH variant found in DIR, or nil if none present." + (save-excursion + (let ((tmp-buffer (get-buffer-create mh-temp-buffer))) + (set-buffer tmp-buffer) + (cond + ((mh-variant-mh-info dir)) + ((mh-variant-nmh-info dir)) + ((mh-variant-mu-mh-info dir)))))) + +;;;###mh-autoload +(defun mh-variants () + "Return a list of installed variants of MH on the system. +This function looks for MH in `mh-sys-path', `mh-path' and +`exec-path'. The format of the list of variants that is returned is described +by the variable `mh-variants'." + (if mh-variants + mh-variants + (let ((list-unique)) + ;; Make a unique list of directories, keeping the given order. + ;; We don't want the same MH variant to be listed multiple times. + (loop for dir in (append mh-path mh-sys-path exec-path) do + (setq dir (file-chase-links (directory-file-name dir))) + (add-to-list 'list-unique dir)) + (loop for dir in (nreverse list-unique) do + (when (and dir (file-directory-p dir) (file-readable-p dir)) + (let ((variant (mh-variant-info dir))) + (if variant + (add-to-list 'mh-variants variant))))) + mh-variants))) + +(provide 'mh-init) + +;;; Local Variables: +;;; indent-tabs-mode: nil +;;; sentence-end-double-space: nil +;;; End: + +;; arch-tag: e8372aeb-d803-42b1-9c95-3c93ad22f63c +;;; mh-init.el ends here diff --git a/lisp/mh-e/mh-junk.el b/lisp/mh-e/mh-junk.el index 42ec4c444d3..095a8c3c3fd 100644 --- a/lisp/mh-e/mh-junk.el +++ b/lisp/mh-e/mh-junk.el @@ -1,6 +1,6 @@ ;;; mh-junk.el --- Interface to anti-spam measures -;; Copyright (C) 2003 Free Software Foundation, Inc. +;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. ;; Author: Satyaki Das <satyaki@theforce.stanford.edu>, ;; Bill Wohler <wohler@newt.com> @@ -32,6 +32,8 @@ ;;; Code: +(eval-when-compile (require 'mh-acros)) +(mh-require-cl) (require 'mh-e) ;; Interactive functions callable from the folder buffer @@ -39,36 +41,33 @@ (defun mh-junk-blacklist (range) "Blacklist RANGE as spam. -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use. +This command trains the spam program in use (see the `mh-junk-program' option) +with the content of the range (see `mh-interactive-range') and then handles +the message(s) as specified by the `mh-junk-disposition' option. -First the appropriate function is called depending on the value of -`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is -refiled to that folder. If nil, the message is deleted. - -To change the spam program being used, customize `mh-junk-program'. Directly -setting `mh-junk-choice' is not recommended. - -The documentation for the following functions describes what setup is needed -for the different spam fighting programs: +For more information about using your particular spam fighting program, see: + - `mh-spamassassin-blacklist' - `mh-bogofilter-blacklist' - - `mh-spamprobe-blacklist' - - `mh-spamassassin-blacklist'" + - `mh-spamprobe-blacklist'" (interactive (list (mh-interactive-range "Blacklist"))) (let ((blacklist-func (nth 1 (assoc mh-junk-choice mh-junk-function-alist)))) (unless blacklist-func (error "Customize `mh-junk-program' appropriately")) - (let ((dest (cond ((null mh-junk-mail-folder) nil) - ((equal mh-junk-mail-folder "") "+") - ((eq (aref mh-junk-mail-folder 0) ?+) - mh-junk-mail-folder) - ((eq (aref mh-junk-mail-folder 0) ?@) + (let ((dest (cond ((null mh-junk-disposition) nil) + ((equal mh-junk-disposition "") "+") + ((eq (aref mh-junk-disposition 0) ?+) + mh-junk-disposition) + ((eq (aref mh-junk-disposition 0) ?@) (concat mh-current-folder "/" - (substring mh-junk-mail-folder 1))) - (t (concat "+" mh-junk-mail-folder))))) + (substring mh-junk-disposition 1))) + (t (concat "+" mh-junk-disposition))))) (mh-iterate-on-range msg range + (message (format "Blacklisting message %d..." msg)) (funcall (symbol-function blacklist-func) msg) + (message (format "Blacklisting message %d...done" msg)) + (if (not (memq msg mh-seen-list)) + (setq mh-seen-list (cons msg mh-seen-list))) (if dest (mh-refile-a-msg nil (intern dest)) (mh-delete-a-msg nil))) @@ -76,231 +75,124 @@ for the different spam fighting programs: ;;;###mh-autoload (defun mh-junk-whitelist (range) - "Whitelist RANGE incorrectly classified as spam. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use. + "Whitelist RANGE as ham. -First the appropriate function is called depending on the value of -`mh-junk-choice'. Then the message is refiled to `mh-inbox'. +This command reclassifies a range of messages (see `mh-interactive-range') as +ham if it were incorrectly classified as spam. It then refiles the message +into the `+inbox' folder. -To change the spam program being used, customize `mh-junk-program'. Directly -setting `mh-junk-choice' is not recommended." +The `mh-junk-program' option specifies the spam program in use." (interactive (list (mh-interactive-range "Whitelist"))) (let ((whitelist-func (nth 2 (assoc mh-junk-choice mh-junk-function-alist)))) (unless whitelist-func (error "Customize `mh-junk-program' appropriately")) (mh-iterate-on-range msg range + (message (format "Whitelisting message %d..." msg)) (funcall (symbol-function whitelist-func) msg) + (message (format "Whitelisting message %d...done" msg)) (mh-refile-a-msg nil (intern mh-inbox))) (mh-next-msg))) -;; Bogofilter Interface - -(defvar mh-bogofilter-executable (executable-find "bogofilter")) - -(defun mh-bogofilter-blacklist (msg) - "Classify MSG as spam. -Tell bogofilter that the message is spam. +;; Spamassassin Interface -Bogofilter is a Bayesian spam filtering program. Get it from your local -distribution or from: - http://bogofilter.sourceforge.net/ +(defvar mh-spamassassin-executable (executable-find "spamassassin")) +(defvar mh-sa-learn-executable (executable-find "sa-learn")) -You first need to teach bogofilter. This is done by running +(defun mh-spamassassin-blacklist (msg) + "Blacklist MSG with SpamAssassin. - bogofilter -n < good-message +SpamAssassin is one of the more popular spam filtering programs. Get it from +your local distribution or from http://spamassassin.org/. -on every good message, and +To use SpamAssassin, add the following recipes to `.procmailrc': - bogofilter -s < spam-message + MAILDIR=$HOME/`mhparam Path` -on every spam message. Most Bayesian filters need 1000 to 5000 of each to -start doing a good job. + # Fight spam with SpamAssassin. + :0fw + | spamc -To use bogofilter, add the following .procmailrc recipes which you can also -find in the bogofilter man page: + # Anything with a spam level of 10 or more is junked immediately. + :0: + * ^X-Spam-Level: .......... + /dev/null - # Bogofilter - :0fw - | bogofilter -u -e -p + :0: + * ^X-Spam-Status: Yes + spam/. - :0 - * ^X-Bogosity: Yes, tests=bogofilter - $SPAM +If you don't use `spamc', use `spamassassin -P -a'. -Bogofilter continues to feed the messages it classifies back into its -database. Occasionally it misses, and those messages need to be reclassified. -MH-E can do this for you. Use \\[mh-junk-blacklist] to reclassify messges in -your +inbox as spam, and \\[mh-junk-whitelist] to reclassify messages in your -spambox as good messages." - (unless mh-bogofilter-executable - (error "Couldn't find the bogofilter executable")) - (let ((msg-file (mh-msg-filename msg mh-current-folder))) - (call-process mh-bogofilter-executable msg-file 0 nil "-Ns"))) +Note that one of the recipes above throws away messages with a score greater +than or equal to 10. Here's how you can determine a value that works best for +you. -(defun mh-bogofilter-whitelist (msg) - "Reinstate incorrectly filtered MSG. -Train bogofilter to think of the message as non-spam." - (unless mh-bogofilter-executable - (error "Couldn't find the bogofilter executable")) - (let ((msg-file (mh-msg-filename msg mh-current-folder))) - (call-process mh-bogofilter-executable msg-file 0 nil "-Sn"))) +First, run `spamassassin -t' on every mail message in your archive and use +Gnumeric to verify that the average plus the standard deviation of good mail +is under 5, the SpamAssassin default for \"spam\". - +Using Gnumeric, sort the messages by score and view the messages with the +highest score. Determine the score which encompasses all of your interesting +messages and add a couple of points to be conservative. Add that many dots to +the `X-Spam-Level:' header field above to send messages with that score down +the drain. -;; Spamprobe Interface +In the example above, messages with a score of 5-9 are set aside in the +`+spam' folder for later review. The major weakness of rules-based filters is +a plethora of false positives so it is worthwhile to check. -(defvar mh-spamprobe-executable (executable-find "spamprobe")) +If SpamAssassin classifies a message incorrectly, or is unsure, you can use +the MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist]. -(defun mh-spamprobe-blacklist (msg) - "Classify MSG as spam. -Tell spamprobe that the message is spam. - -Spamprobe is a Bayesian spam filtering program. More info about the program can -be found at: - http://spamprobe.sourceforge.net - -Here is a procmail recipe to stores incoming spam mail into the folder +spam -and good mail in /home/user/Mail/mdrop/mbox. This recipe is provided as an -example in the spamprobe man page. - - PATH=/bin:/usr/bin:/usr/local/bin - DEFAULT=/home/user/Mail/mdrop/mbox - SPAM=/home/user/Mail/spam/. - - # Spamprobe filtering - :0 - SCORE=| spamprobe receive - :0 wf - | formail -I \"X-SpamProbe: $SCORE\" - :0 a: - *^X-SpamProbe: SPAM - $SPAM - -Occasionally some good mail gets misclassified as spam. You can use -\\[mh-junk-whitelist] to reclassify that as good mail." - (unless mh-spamprobe-executable - (error "Couldn't find the spamprobe executable")) - (let ((msg-file (mh-msg-filename msg mh-current-folder))) - (call-process mh-spamprobe-executable msg-file 0 nil "spam"))) +The \\[mh-junk-blacklist] command adds a `blacklist_from' entry to +`~/spamassassin/user_prefs', deletes the message, and sends the message to the +Razor, so that others might not see this spam. If the `sa-learn' command is +available, the message is also recategorized as spam. -(defun mh-spamprobe-whitelist (msg) - "Reinstate incorrectly filtered MSG. -Train spamprobe to think of the message as non-spam." - (unless mh-spamprobe-executable - (error "Couldn't find the spamprobe executable")) - (let ((msg-file (mh-msg-filename msg mh-current-folder))) - (call-process mh-spamprobe-executable msg-file 0 nil "good"))) +The \\[mh-junk-whitelist] command adds a `whitelist_from' rule to the +`~/.spamassassin/user_prefs' file. If the `sa-learn' command is available, the +message is also recategorized as ham. - +Over time, you'll observe that the same host or domain occurs repeatedly in +the `blacklist_from' entries, so you might think that you could avoid future +spam by blacklisting all mail from a particular domain. The utility function +`mh-spamassassin-identify-spammers' helps you do precisely that. This function +displays a frequency count of the hosts and domains in the `blacklist_from' +entries from the last blank line in `~/.spamassassin/user_prefs' to the end of +the file. This information can be used so that you can replace multiple +`blacklist_from' entries with a single wildcard entry such as: -;; Spamassassin Interface + blacklist_from *@*amazingoffersdirect2u.com -(defvar mh-spamassassin-executable (executable-find "spamassassin")) -(defvar mh-sa-learn-executable (executable-find "sa-learn")) +In versions of SpamAssassin (2.50 and on) that support a Bayesian classifier, +\\[mh-junk-blacklist] uses the `sa-learn' program to recategorize the message +as spam. Neither MH-E, nor SpamAssassin, rebuilds the database after adding +words, so you will need to run `sa-learn --rebuild' periodically. This can be +done by adding the following to your crontab: -(defun mh-spamassassin-blacklist (msg) - "Blacklist MSG. -This is done by sending the message to Razor and by appending the sender to -~/.spamassassin/user_prefs in a blacklist_from rule. If sa-learn is available, -the message is also recategorized as spam. - -Spamassassin is an excellent spam filter. For more information, see: - http://spamassassin.org/. - -I ran \"spamassassin -t\" on every mail message in my archive and ran an -analysis in Gnumeric to find that the standard deviation of good mail -scored under 5 (coincidentally, the spamassassin default for \"spam\"). - -Furthermore, I observed that there weren't any messages with a score of 8 -or more that were interesting, so I added a couple of points to be -conservative and send any message with a score of 10 or more down the -drain. You might want to use a score of 12 or 13 to be really conservative. -I have found that this really decreases the amount of junk to review. - -Messages with a score of 5-9 are set aside for later review. The major -weakness of rules-based filters is a plethora of false positives\; I catch one -or two legitimate messages in here a week, so it is worthwhile to check. - -You might choose to do this analysis yourself to pick a good score for -deleting spam sight unseen, or you might pick a score out of a hat, or you -might choose to be very conservative and not delete any messages at all. - -Based upon this discussion, here is what the associated ~/.procmailrc -entries look like. These rules appear before my list filters so that spam -sent to mailing lists gets pruned too. - - # - # Spam - # - :0fw - | spamc - - # Anything with a spam level of 10 or more is junked immediately. - :0: - * ^X-Spam-Level: .......... - /dev/null - - :0 - * ^X-Spam-Status: Yes - $SPAM - -If you don't use \"spamc\", use \"spamassassin -P -a\". - -A handful of spam does find its way into +inbox. In this case, use -\\[mh-junk-blacklist] to add a \"blacklist_from\" line to -~/spamassassin/user_prefs, delete the message, and send the message to the -Razor, so that others might not see this spam. - -Over time, you see some patterns in the blacklisted addresses and can -replace several lines with wildcards. For example, it is clear that High -Speed Media is the biggest bunch of jerks on the Net. Here are some of the -entries I have for them, and the list continues to grow. - - blacklist_from *@*-hsm-*.com - blacklist_from *@*182*643*.com - blacklist_from *@*antarhsm*.com - blacklist_from *@*h*speed* - blacklist_from *@*hsm*182*.com - blacklist_from *@*hsm*643*.com - blacklist_from *@*hsmridi2983cslt227.com - blacklist_from *@*list*hsm*.com - blacklist_from *@h*s*media* - blacklist_from *@hsmdrct.com - blacklist_from *@hsmridi2983csltsite.com - -The function `mh-spamassassin-identify-spammers' is provided that shows the -frequency counts of the host and domain names in your blacklist_from -entries. This can be helpful when editing the blacklist_from entries. - -In versions of spamassassin (2.50 and on) that support a Bayesian classifier, -\\[mh-junk-blacklist] uses the sa-learn program to recategorize the message as -spam. Neither MH-E, nor spamassassin, rebuilds the database after adding -words, so you will need to run \"sa-learn --rebuild\" periodically. This can -be done by adding the following to your crontab: - - 0 * * * * sa-learn --rebuild > /dev/null 2>&1" + 0 * * * * sa-learn --rebuild > /dev/null 2>&1" (unless mh-spamassassin-executable - (error "Couldn't find the spamassassin executable")) + (error "Unable to find the spamassassin executable")) (let ((current-folder mh-current-folder) (msg-file (mh-msg-filename msg mh-current-folder)) (sender)) (save-excursion - (message "Giving this message the Razor...") + (message (format "Reporting message %d..." msg)) (mh-truncate-log-buffer) (call-process mh-spamassassin-executable msg-file mh-log-buffer nil - "--report" "--remove-from-whitelist") + ;;"--report" "--remove-from-whitelist" + "-r" "-R") ; spamassassin V2.20 (when mh-sa-learn-executable (message "Recategorizing this message as spam...") (call-process mh-sa-learn-executable msg-file mh-log-buffer nil "--single" "--spam" "--local" "--no-rebuild")) - (message "Blacklisting address...") + (message (format "Blacklisting message %d..." msg)) (set-buffer (get-buffer-create mh-temp-buffer)) (erase-buffer) - (call-process (expand-file-name mh-scan-prog mh-progs) nil t nil + (call-process (expand-file-name mh-scan-prog mh-progs) mh-junk-background + t nil (format "%s" msg) current-folder "-format" "%<(mymbox{from})%|%(addr{from})%>") (goto-char (point-min)) @@ -308,15 +200,19 @@ be done by adding the following to your crontab: (progn (setq sender (match-string 0)) (mh-spamassassin-add-rule "blacklist_from" sender) - (message "Blacklisting address...done")) - (message "Blacklisting address...not done (from my address)"))))) + (message (format "Blacklisting message %d...done" msg))) + (message (format "Blacklisting message %d...not done (from my address)" msg)))))) (defun mh-spamassassin-whitelist (msg) - "Whitelist MSG. -Add a whitelist_from rule to the ~/.spamassassin/user_prefs file. If sa-learn -is available, then the message is recategorized as ham." + "Whitelist MSG with SpamAssassin. + +The \\[mh-junk-whitelist] command adds a `whitelist_from' rule to the +`~/.spamassassin/user_prefs' file. If the `sa-learn' command is available, the +message is also recategorized as ham. + +See `mh-spamassassin-blacklist' for more information." (unless mh-spamassassin-executable - (error "Couldn't find the spamassassin executable")) + (error "Unable to find the spamassassin executable")) (let ((msg-file (mh-msg-filename msg mh-current-folder)) (show-buffer (get-buffer mh-show-buffer)) from) @@ -325,7 +221,8 @@ is available, then the message is recategorized as ham." (erase-buffer) (message "Removing spamassassin markup from message...") (call-process mh-spamassassin-executable msg-file mh-temp-buffer nil - "--remove-markup") + ;; "--remove-markup" + "-d") ; spamassassin V2.20 (if show-buffer (kill-buffer show-buffer)) (write-file msg-file) @@ -333,15 +230,17 @@ is available, then the message is recategorized as ham." (message "Recategorizing this message as ham...") (call-process mh-sa-learn-executable msg-file mh-temp-buffer nil "--single" "--ham" "--local --no-rebuild")) - (message "Whitelisting address...") - (setq from (car (ietf-drums-parse-address (mh-get-header-field "From:")))) + (message (format "Whitelisting message %d..." msg)) + (setq from + (car (mh-funcall-if-exists + ietf-drums-parse-address (mh-get-header-field "From:")))) (kill-buffer nil) - (unless (equal from "") + (unless (or (null from) (equal from "")) (mh-spamassassin-add-rule "whitelist_from" from)) - (message "Whitelisting address...done")))) + (message (format "Whitelisting message %d...done" msg))))) (defun mh-spamassassin-add-rule (rule body) - "Add a new rule to ~/.spamassassin/user_prefs. + "Add a new rule to `~/.spamassassin/user_prefs'. The name of the rule is RULE and its body is BODY." (save-window-excursion (let* ((line (format "%s\t%s\n" rule body)) @@ -358,15 +257,15 @@ The name of the rule is RULE and its body is BODY." (kill-buffer nil))))) (defun mh-spamassassin-identify-spammers () - "Identifies spammers who are repeat offenders. + "Identify spammers who are repeat offenders. -For each blacklist_from entry from the last blank line of -~/.spamassassin/user_prefs to the end of the file, a list of host and domain -names along with their frequency counts is displayed. This information can be -used to replace multiple blacklist_from entries with a single wildcard entry -such as: +This function displays a frequency count of the hosts and domains in the +`blacklist_from' entries from the last blank line in +`~/.spamassassin/user_prefs' to the end of the file. This information can be +used so that you can replace multiple `blacklist_from' entries with a single +wildcard entry such as: - blacklist_from *@*amazingoffersdirect2u.com" + blacklist_from *@*amazingoffersdirect2u.com" (interactive) (let* ((file (expand-file-name "~/.spamassassin/user_prefs")) (domains (make-hash-table :test 'equal))) @@ -385,7 +284,7 @@ such as: ;; Add counts for each host and domain part. (while host (setq value (gethash (car host) domains)) - (puthash (car host) (1+ (if (not value) 0 value)) domains) + (setf (gethash (car host) domains) (1+ (if (not value) 0 value))) (setq host (cdr host)))))) ;; Output @@ -400,6 +299,121 @@ such as: (reverse-region (point-min) (point-max)) (goto-char (point-min)))) + + +;; Bogofilter Interface + +(defvar mh-bogofilter-executable (executable-find "bogofilter")) + +(defun mh-bogofilter-blacklist (msg) + "Blacklist MSG with Bogofilter. + +Bogofilter is a Bayesian spam filtering program. Get it from your local +distribution or from http://bogofilter.sourceforge.net/. + +Bogofilter is taught by running: + + bogofilter -n < good-message + +on every good message, and + + bogofilter -s < spam-message + +on every spam message. This is called a full training; three other +training methods are described in the FAQ that is distributed with bogofilter. +Note that most Bayesian filters need 1000 to 5000 of each type of message to +start doing a good job. + +To use Bogofilter, add the following recipes to `.procmailrc': + + MAILDIR=$HOME/`mhparam Path` + + # Fight spam with Bogofilter. + :0fw + | bogofilter -3 -e -p + + :0: + * ^X-Bogosity: Yes, tests=bogofilter + spam/. + + :0: + * ^X-Bogosity: Unsure, tests=bogofilter + spam/unsure/. + +If Bogofilter classifies a message incorrectly, or is unsure, you can use the +MH-E commands \\[mh-junk-blacklist] and \\[mh-junk-whitelist] to update +Bogofilter's training. + +The \"Bogofilter FAQ\" suggests that you run the following +occasionally to shrink the database: + + bogoutil -d wordlist.db | bogoutil -l wordlist.db.new + mv wordlist.db wordlist.db.prv + mv wordlist.db.new wordlist.db + +The \"Bogofilter tuning HOWTO\" describes how you can fine-tune Bogofilter." + (unless mh-bogofilter-executable + (error "Unable to find the bogofilter executable")) + (let ((msg-file (mh-msg-filename msg mh-current-folder))) + (call-process mh-bogofilter-executable msg-file mh-junk-background + nil "-s"))) + +(defun mh-bogofilter-whitelist (msg) + "Whitelist MSG with Bogofilter. + +See `mh-bogofilter-blacklist' for more information." + (unless mh-bogofilter-executable + (error "Unable to find the bogofilter executable")) + (let ((msg-file (mh-msg-filename msg mh-current-folder))) + (call-process mh-bogofilter-executable msg-file mh-junk-background + nil "-n"))) + + + +;; Spamprobe Interface + +(defvar mh-spamprobe-executable (executable-find "spamprobe")) + +(defun mh-spamprobe-blacklist (msg) + "Blacklist MSG with SpamProbe. + +SpamProbe is a Bayesian spam filtering program. Get it from your local +distribution or from http://spamprobe.sourceforge.net. + +To use SpamProbe, add the following recipes to `.procmailrc': + + MAILDIR=$HOME/`mhparam Path` + + # Fight spam with SpamProbe. + :0 + SCORE=| spamprobe receive + + :0 wf + | formail -I \"X-SpamProbe: $SCORE\" + + :0: + *^X-SpamProbe: SPAM + spam/. + +If SpamProbe classifies a message incorrectly, you can use the MH-E commands +\\[mh-junk-blacklist] and \\[mh-junk-whitelist] to update SpamProbe's +training." + (unless mh-spamprobe-executable + (error "Unable to find the spamprobe executable")) + (let ((msg-file (mh-msg-filename msg mh-current-folder))) + (call-process mh-spamprobe-executable msg-file mh-junk-background + nil "spam"))) + +(defun mh-spamprobe-whitelist (msg) + "Whitelist MSG with SpamProbe. + +See `mh-spamprobe-blacklist' for more information." + (unless mh-spamprobe-executable + (error "Unable to find the spamprobe executable")) + (let ((msg-file (mh-msg-filename msg mh-current-folder))) + (call-process mh-spamprobe-executable msg-file mh-junk-background + nil "good"))) + (provide 'mh-junk) ;;; Local Variables: diff --git a/lisp/mh-e/mh-loaddefs.el b/lisp/mh-e/mh-loaddefs.el index a5578760845..fd989ffa3b9 100644 --- a/lisp/mh-e/mh-loaddefs.el +++ b/lisp/mh-e/mh-loaddefs.el @@ -11,22 +11,24 @@ ;;;;;; mh-beginning-of-word mh-complete-word mh-open-line mh-fully-kill-draft ;;;;;; mh-yank-cur-msg mh-insert-letter mh-send-letter mh-insert-auto-fields ;;;;;; mh-check-whom mh-insert-signature mh-to-fcc mh-to-field mh-fill-paragraph-function -;;;;;; mh-send-other-window mh-send mh-reply mh-redistribute mh-forward -;;;;;; mh-extract-rejected-mail mh-edit-again) "mh-comp" "mh-comp.el" -;;;;;; (16625 53169)) +;;;;;; mh-get-header-field mh-send-other-window mh-send mh-reply +;;;;;; mh-redistribute mh-forward mh-extract-rejected-mail mh-edit-again) +;;;;;; "mh-comp" "mh-comp.el" (16665 53716)) ;;; Generated autoloads from mh-comp.el (autoload (quote mh-edit-again) "mh-comp" "\ Clean up a draft or a message MSG previously sent and make it resendable. Default is the current message. The variable `mh-new-draft-cleaned-headers' specifies the headers to remove. -See also documentation for `\\[mh-send]' function." t nil) + +See also `mh-send'." t nil) (autoload (quote mh-extract-rejected-mail) "mh-comp" "\ Extract message MSG returned by the mail system and make it resendable. Default is the current message. The variable `mh-new-draft-cleaned-headers' gives the headers to clean out of the original message. -See also documentation for `\\[mh-send]' function." t nil) + +See also `mh-send'." t nil) (autoload (quote mh-forward) "mh-comp" "\ Forward messages to the recipients TO and CC. @@ -36,7 +38,7 @@ Default is the displayed message. Check the documentation of `mh-interactive-range' to see how RANGE is read in interactive use. -See also documentation for `\\[mh-send]' function." t nil) +See also `mh-send'." t nil) (autoload (quote mh-redistribute) "mh-comp" "\ Redistribute displayed message to recipients TO and CC. @@ -55,11 +57,12 @@ to reply to: If optional prefix argument INCLUDEP provided, then include the message in the reply using filter `mhl.reply' in your MH directory. If the file named by `mh-repl-formfile' exists, it is used as a skeleton -for the reply. See also documentation for `\\[mh-send]' function." t nil) +for the reply. + +See also `mh-send'." t nil) (autoload (quote mh-send) "mh-comp" "\ Compose and send a letter. - Do not call this function from outside MH-E; use \\[mh-smail] instead. The file named by `mh-comp-formfile' will be used as the form. @@ -70,7 +73,6 @@ passed three arguments: TO, CC, and SUBJECT." t nil) (autoload (quote mh-send-other-window) "mh-comp" "\ Compose and send a letter in another window. - Do not call this function from outside MH-E; use \\[mh-smail-other-window] instead. @@ -80,6 +82,11 @@ details. If `mh-compose-letter-function' is defined, it is called on the draft and passed three arguments: TO, CC, and SUBJECT." t nil) +(autoload (quote mh-get-header-field) "mh-comp" "\ +Find and return the body of FIELD in the mail header. +Returns the empty string if the field is not in the header of the +current buffer." nil nil) + (autoload (quote mh-fill-paragraph-function) "mh-comp" "\ Fill paragraph at or after point. Prefix ARG means justify as well. This function enables `fill-paragraph' to @@ -96,9 +103,12 @@ Insert an Fcc: FOLDER field in the current message. Prompt for the field name with a completion list of the current folders." t nil) (autoload (quote mh-insert-signature) "mh-comp" "\ -Insert the file named by `mh-signature-file-name' at point. +Insert the signature specified by `mh-signature-file-name' or FILE at point. +A signature separator (`-- ') will be added if the signature block does not +contain one and `mh-signature-separator-flag' is on. The value of `mh-letter-insert-signature-hook' is a list of functions to be -called, with no arguments, before the signature is actually inserted." t nil) +called, with no arguments, after the signature is inserted. +The signature can also be inserted with `mh-identity-list'." t nil) (autoload (quote mh-check-whom) "mh-comp" "\ Verify recipients of the current letter, showing expansion of any aliases." t nil) @@ -109,7 +119,9 @@ Sets buffer-local `mh-insert-auto-fields-done-local' when done and inserted something. If NON-INTERACTIVE is non-nil, do not be verbose and only attempt matches if `mh-insert-auto-fields-done-local' is nil. -An `identity' entry is skipped if one was already entered manually." t nil) +An `identity' entry is skipped if one was already entered manually. + +Return t if fields added; otherwise return nil." t nil) (autoload (quote mh-send-letter) "mh-comp" "\ Send the draft letter in the current buffer. @@ -117,13 +129,12 @@ If optional prefix argument ARG is provided, monitor delivery. The value of `mh-before-send-letter-hook' is a list of functions to be called, with no arguments, before doing anything. Run `\\[mh-edit-mhn]' if mhn directives are present; otherwise -run `\\[mh-mml-to-mime]' if mml directives are present. -Insert X-Mailer field if variable `mh-insert-x-mailer-flag' is set. -Insert X-Face field if the file specified by `mh-x-face-file' exists." t nil) +run `\\[mh-mml-to-mime]' if mml directives are present." t nil) (autoload (quote mh-insert-letter) "mh-comp" "\ Insert a message into the current letter. -Removes the header fields according to the variable `mh-invisible-headers'. +Removes the header fields according to the variable +`mh-invisible-header-fields-compiled'. Prefixes each non-blank line with `mh-ins-buf-prefix', unless `mh-yank-from-start-of-msg' is set for supercite in which case supercite is used to format the message. @@ -168,42 +179,11 @@ If we are at the first header field go to the start of the message body." t nil) ;;;*** -;;;### (autoloads (mh-customize) "mh-customize" "mh-customize.el" -;;;;;; (16625 53481)) -;;; Generated autoloads from mh-customize.el - -(autoload (quote mh-customize) "mh-customize" "\ -Customize MH-E variables. -With optional argument DELETE-OTHER-WINDOWS-FLAG, other windows in the frame -are removed." t nil) - -;;;*** - -;;;### (autoloads (mh-goto-cur-msg mh-update-sequences mh-folder-line-matches-show-buffer-p) -;;;;;; "mh-e" "mh-e.el" (16627 22341)) -;;; Generated autoloads from mh-e.el - -(autoload (quote mh-folder-line-matches-show-buffer-p) "mh-e" "\ -Return t if the message under point in folder-mode is in the show buffer. -Return nil in any other circumstance (no message under point, no show buffer, -the message in the show buffer doesn't match." nil nil) - -(autoload (quote mh-update-sequences) "mh-e" "\ -Update MH's Unseen-Sequence and current folder and message. -Flush MH-E's state out to MH. The message at the cursor becomes current." t nil) - -(autoload (quote mh-goto-cur-msg) "mh-e" "\ -Position the cursor at the current message. -When optional argument MINIMAL-CHANGES-FLAG is non-nil, the function doesn't -recenter the folder buffer." nil nil) - -;;;*** - ;;;### (autoloads (mh-prefix-help mh-help mh-ephem-message mh-store-buffer -;;;;;; mh-store-msg mh-undo-folder mh-sort-folder mh-print-msg mh-page-digest-backwards +;;;;;; mh-store-msg mh-undo-folder mh-sort-folder mh-page-digest-backwards ;;;;;; mh-page-digest mh-pipe-msg mh-pack-folder mh-list-folders ;;;;;; mh-kill-folder mh-copy-msg mh-burst-digest) "mh-funcs" "mh-funcs.el" -;;;;;; (16625 54011)) +;;;;;; (16671 48788)) ;;; Generated autoloads from mh-funcs.el (autoload (quote mh-burst-digest) "mh-funcs" "\ @@ -245,15 +225,6 @@ Advance displayed message to next digested message." t nil) (autoload (quote mh-page-digest-backwards) "mh-funcs" "\ Back up displayed message to previous digested message." t nil) -(autoload (quote mh-print-msg) "mh-funcs" "\ -Print RANGE on printer. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use. - -The variable `mh-lpr-command-format' is used to generate the print command. -The messages are formatted by mhl. See the variable `mhl-formfile'." t nil) - (autoload (quote mh-sort-folder) "mh-funcs" "\ Sort the messages in the current folder by date. Calls the MH program sortm to do the work. @@ -261,8 +232,7 @@ The arguments in the list `mh-sortm-args' are passed to sortm if the optional argument EXTRA-ARGS is given." t nil) (autoload (quote mh-undo-folder) "mh-funcs" "\ -Undo all pending deletes and refiles in current folder. -Argument IGNORE is deprecated." t nil) +Undo all pending deletes and refiles in current folder." t nil) (autoload (quote mh-store-msg) "mh-funcs" "\ Store the file(s) contained in the current message into DIRECTORY. @@ -280,19 +250,24 @@ Default directory is the last directory used, or initially the value of Display STRING in the minibuffer momentarily." nil nil) (autoload (quote mh-help) "mh-funcs" "\ -Display cheat sheet for the MH-Folder commands in minibuffer." t nil) +Display cheat sheet for the MH-E commands." t nil) (autoload (quote mh-prefix-help) "mh-funcs" "\ Display cheat sheet for the commands of the current prefix in minibuffer." t nil) ;;;*** -;;;### (autoloads (mh-insert-identity mh-identity-list-set mh-identity-make-menu) -;;;;;; "mh-identity" "mh-identity.el" (16625 54171)) +;;;### (autoloads (mh-identity-handler-bottom mh-identity-handler-top +;;;;;; mh-identity-insert-attribution-verb mh-identity-handler-attribution-verb +;;;;;; mh-identity-handler-signature mh-identity-handler-gpg-identity +;;;;;; mh-insert-identity mh-identity-list-set mh-identity-make-menu) +;;;;;; "mh-identity" "mh-identity.el" (16671 57010)) ;;; Generated autoloads from mh-identity.el (autoload (quote mh-identity-make-menu) "mh-identity" "\ -Build (or rebuild) the Identity menu (e.g. after the list is modified)." nil nil) +Build the Identity menu. +This should be called any time `mh-identity-list' or `mh-auto-fields-list' +change." nil nil) (autoload (quote mh-identity-list-set) "mh-identity" "\ Update the `mh-identity-list' variable, and rebuild the menu. @@ -304,10 +279,35 @@ customization). This is called after 'customize is used to alter Insert proper fields for given IDENTITY. Edit the `mh-identity-list' variable to define identity." t nil) +(autoload (quote mh-identity-handler-gpg-identity) "mh-identity" "\ +For FIELD \"pgg-default-user-id\", process for ACTION 'remove or 'add. +The buffer-local variable `mh-identity-pgg-default-user-id' is set to VALUE +when action 'add is selected." nil nil) + +(autoload (quote mh-identity-handler-signature) "mh-identity" "\ +For FIELD \"signature\", process headers for ACTION 'remove or 'add. +The VALUE is added." nil nil) + +(autoload (quote mh-identity-handler-attribution-verb) "mh-identity" "\ +For FIELD \"attribution_verb\", process headers for ACTION 'remove or 'add. +The VALUE is added." nil nil) + +(autoload (quote mh-identity-insert-attribution-verb) "mh-identity" "\ +Insert VALUE as attribution verb, setting up delimiting markers. +If VALUE is nil, use `mh-extract-from-attribution-verb'." nil nil) + +(autoload (quote mh-identity-handler-top) "mh-identity" "\ +For FIELD, process mh-identity headers for ACTION 'remove or 'add. +If the field wasn't present, the VALUE is added at the top of the header." nil nil) + +(autoload (quote mh-identity-handler-bottom) "mh-identity" "\ +For FIELD, process mh-identity headers for ACTION 'remove or 'add. +If the field wasn't present, the VALUE is added at the bottom of the header." nil nil) + ;;;*** -;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16625 -;;;;;; 54212)) +;;;### (autoloads (mh-inc-spool-list-set) "mh-inc" "mh-inc.el" (16671 +;;;;;; 48848)) ;;; Generated autoloads from mh-inc.el (autoload (quote mh-inc-spool-list-set) "mh-inc" "\ @@ -319,14 +319,14 @@ This is called after 'customize is used to alter `mh-inc-spool-list'." nil nil) ;;;### (autoloads (mh-index-choose mh-namazu-execute-search mh-swish++-execute-search ;;;;;; mh-swish-execute-search mh-index-ticked-messages mh-index-new-messages -;;;;;; mh-index-sequenced-messages mh-glimpse-execute-search mh-index-delete-from-sequence -;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-update-unseen -;;;;;; mh-index-visit-folder mh-index-delete-folder-headers mh-index-group-by-folder +;;;;;; mh-index-sequenced-messages mh-index-delete-from-sequence +;;;;;; mh-index-add-to-sequence mh-index-execute-commands mh-index-visit-folder +;;;;;; mh-index-delete-folder-headers mh-index-group-by-folder mh-index-create-imenu-index ;;;;;; mh-index-insert-folder-headers mh-index-previous-folder mh-index-next-folder ;;;;;; mh-index-parse-search-regexp mh-index-do-search mh-index-p ;;;;;; mh-index-read-data mh-index-search mh-index-create-sequences ;;;;;; mh-create-sequence-map mh-index-update-maps) "mh-index" "mh-index.el" -;;;;;; (16625 54348)) +;;;;;; (16665 53754)) ;;; Generated autoloads from mh-index.el (autoload (quote mh-index-update-maps) "mh-index" "\ @@ -367,7 +367,6 @@ index for each program: - `mh-swish-execute-search' - `mh-mairix-execute-search' - `mh-namazu-execute-search' - - `mh-glimpse-execute-search' If none of these programs are present then we use pick. If desired grep can be used instead. Details about these methods can be found in: @@ -411,6 +410,9 @@ Jump to the previous folder marker." t nil) (autoload (quote mh-index-insert-folder-headers) "mh-index" "\ Annotate the search results with original folder names." nil nil) +(autoload (quote mh-index-create-imenu-index) "mh-index" "\ +Create alist of folder names and positions in index folder buffers." nil nil) + (autoload (quote mh-index-group-by-folder) "mh-index" "\ Partition the messages based on source folder. Returns an alist with the the folder names in the car and the cdr being the @@ -422,10 +424,6 @@ Delete the folder headers." nil nil) (autoload (quote mh-index-visit-folder) "mh-index" "\ Visit original folder from where the message at point was found." t nil) -(autoload (quote mh-index-update-unseen) "mh-index" "\ -Remove counterpart of MSG in source folder from `mh-unseen-seq'. -Also `mh-update-unseen' is called in the original folder, if we have it open." nil nil) - (autoload (quote mh-index-execute-commands) "mh-index" "\ Delete/refile the actual messages. The copies in the searched folder are then deleted/refiled to get the desired @@ -442,62 +440,25 @@ Delete from SEQ the messages in MSGS. This function updates the source folder sequences. Also makes an attempt to update the source folder buffer if present." nil nil) -(autoload (quote mh-glimpse-execute-search) "mh-index" "\ -Execute glimpse and read the results. - -In the examples below, replace /home/user/Mail with the path to your MH -directory. - -First create the directory /home/user/Mail/.glimpse. Then create the file -/home/user/Mail/.glimpse/.glimpse_exclude with the following contents: - - */.* - */#* - */,* - */*~ - ^/home/user/Mail/.glimpse - ^/home/user/Mail/mhe-index - -If there are any directories you would like to ignore, append lines like the -following to .glimpse_exclude: - - ^/home/user/Mail/scripts - -You do not want to index the folders that hold the results of your searches -since they tend to be ephemeral and the original messages are indexed anyway. -The configuration file above assumes that the results are found in sub-folders -of `mh-index-folder' which is +mhe-index by default. - -Use the following command line to generate the glimpse index. Run this -daily from cron: - - glimpseindex -H /home/user/Mail/.glimpse /home/user/Mail - -FOLDER-PATH is the directory in which SEARCH-REGEXP is used to search." nil nil) - (autoload (quote mh-index-sequenced-messages) "mh-index" "\ Display messages from FOLDERS in SEQUENCE. -By default the folders specified by `mh-index-new-messages-folders' are -searched. With a prefix argument, enter a space-separated list of folders, or -nothing to search all folders. - -Argument SEQUENCE defaults to `mh-unseen-seq' and is the sequence that the -function searches for in each of the FOLDERS. With a prefix argument, enter a -sequence to use." t nil) +All messages in the sequence you provide from the folders in +`mh-index-new-messages-folders' are listed. With a prefix argument, enter a +space-separated list of folders, or nothing to search all folders." t nil) (autoload (quote mh-index-new-messages) "mh-index" "\ Display unseen messages. -All messages in the `unseen' sequence from FOLDERS are displayed. -By default the folders specified by `mh-index-new-messages-folders' -are searched. With a prefix argument, enter a space-separated list of -folders, or nothing to search all folders." t nil) +If you use a program such as `procmail' to use `rcvstore' to file your +incoming mail automatically, you can display new, unseen, messages using this +command. All messages in the `unseen' sequence from the folders in +`mh-index-new-messages-folders' are listed. With a prefix argument, enter a +space-separated list of FOLDERS, or nothing to search all folders." t nil) (autoload (quote mh-index-ticked-messages) "mh-index" "\ Display ticked messages. -All messages in the `tick' sequence from FOLDERS are displayed. -By default the folders specified by `mh-index-ticked-messages-folders' -are searched. With a prefix argument, enter a space-separated list of -folders, or nothing to search all folders." t nil) +All messages in `mh-tick-seq' from the folders in +`mh-index-ticked-messages-folders' are listed. With a prefix argument, enter a +space-separated list of FOLDERS, or nothing to search all folders." t nil) (autoload (quote mh-swish-execute-search) "mh-index" "\ Execute swish-e and read the results. @@ -620,54 +581,70 @@ system." nil nil) ;;;*** +;;;### (autoloads (mh-variants mh-variant-p mh-variant-set) "mh-init" +;;;;;; "mh-init.el" (16684 6777)) +;;; Generated autoloads from mh-init.el + +(autoload (quote mh-variant-set) "mh-init" "\ +Set the MH variant to VARIANT. +Sets `mh-progs', `mh-lib', `mh-lib-progs' and `mh-flists-present-flag'. +If the VARIANT is `autodetect', then first try nmh, then MH and finally +GNU mailutils." t nil) + +(autoload (quote mh-variant-p) "mh-init" "\ +Return t if variant is any of VARIANTS. +Currently known variants are 'MH, 'nmh, and 'mu-mh." nil nil) + +(autoload (quote mh-variants) "mh-init" "\ +Return a list of installed variants of MH on the system. +This function looks for MH in `mh-sys-path', `mh-path' and +`exec-path'. The format of the list of variants that is returned is described +by the variable `mh-variants'." nil nil) + +;;;*** + ;;;### (autoloads (mh-junk-whitelist mh-junk-blacklist) "mh-junk" -;;;;;; "mh-junk.el" (16625 54386)) +;;;;;; "mh-junk.el" (16671 48929)) ;;; Generated autoloads from mh-junk.el (autoload (quote mh-junk-blacklist) "mh-junk" "\ Blacklist RANGE as spam. -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use. - -First the appropriate function is called depending on the value of -`mh-junk-choice'. Then if `mh-junk-mail-folder' is a string then the message is -refiled to that folder. If nil, the message is deleted. +This command trains the spam program in use (see the `mh-junk-program' option) +with the content of the range (see `mh-interactive-range') and then handles +the message(s) as specified by the `mh-junk-disposition' option. -To change the spam program being used, customize `mh-junk-program'. Directly -setting `mh-junk-choice' is not recommended. - -The documentation for the following functions describes what setup is needed -for the different spam fighting programs: +For more information about using your particular spam fighting program, see: + - `mh-spamassassin-blacklist' - `mh-bogofilter-blacklist' - - `mh-spamprobe-blacklist' - - `mh-spamassassin-blacklist'" t nil) + - `mh-spamprobe-blacklist'" t nil) (autoload (quote mh-junk-whitelist) "mh-junk" "\ -Whitelist RANGE incorrectly classified as spam. - -Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use. +Whitelist RANGE as ham. -First the appropriate function is called depending on the value of -`mh-junk-choice'. Then the message is refiled to `mh-inbox'. +This command reclassifies a range of messages (see `mh-interactive-range') as +ham if it were incorrectly classified as spam. It then refiles the message +into the `+inbox' folder. -To change the spam program being used, customize `mh-junk-program'. Directly -setting `mh-junk-choice' is not recommended." t nil) +The `mh-junk-program' option specifies the spam program in use." t nil) ;;;*** -;;;### (autoloads (mh-mime-inline-part mh-mime-save-part mh-push-button -;;;;;; mh-press-button mh-mime-display mh-decode-message-header -;;;;;; mh-mime-save-parts mh-display-emphasis mh-display-smileys -;;;;;; mh-add-missing-mime-version-header mh-destroy-postponed-handles -;;;;;; mh-mime-cleanup mh-mml-directive-present-p mh-mml-secure-message-encrypt-pgpmime -;;;;;; mh-mml-secure-message-sign-pgpmime mh-mml-attach-file mh-mml-forward-message +;;;### (autoloads (mh-display-with-external-viewer mh-mime-inline-part +;;;;;; mh-mime-save-part mh-push-button mh-press-button mh-mime-display +;;;;;; mh-decode-message-header mh-toggle-mh-decode-mime-flag mh-mime-save-parts +;;;;;; mh-display-emphasis mh-display-smileys mh-add-missing-mime-version-header +;;;;;; mh-destroy-postponed-handles mh-mime-cleanup mh-mml-directive-present-p +;;;;;; mh-mml-secure-message-signencrypt mh-mml-secure-message-encrypt +;;;;;; mh-mml-secure-message-sign mh-mml-unsecure-message mh-mml-attach-file +;;;;;; mh-mml-query-cryptographic-method mh-mml-forward-message ;;;;;; mh-mml-to-mime mh-mhn-directive-present-p mh-revert-mhn-edit -;;;;;; mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-compressed-tar -;;;;;; mh-mhn-compose-anon-ftp mh-mhn-compose-insertion mh-compose-forward -;;;;;; mh-compose-insertion) "mh-mime" "mh-mime.el" (16625 54523)) +;;;;;; mh-edit-mhn mh-mhn-compose-forw mh-mhn-compose-external-type +;;;;;; mh-mhn-compose-external-compressed-tar mh-mhn-compose-anon-ftp +;;;;;; mh-mhn-compose-insertion mh-file-mime-type mh-have-file-command +;;;;;; mh-compose-forward mh-compose-insertion) "mh-mime" "mh-mime.el" +;;;;;; (16684 7323)) ;;; Generated autoloads from mh-mime.el (autoload (quote mh-compose-insertion) "mh-mime" "\ @@ -686,6 +663,14 @@ come. Optional argument MESSAGE is the message to forward. If any of the optional arguments are absent, they are prompted for." t nil) +(autoload (quote mh-have-file-command) "mh-mime" "\ +Return t if 'file' command is on the system. +'file -i' is used to get MIME type of composition insertion." nil nil) + +(autoload (quote mh-file-mime-type) "mh-mime" "\ +Return MIME type of FILENAME from file command. +Returns nil if file command not on system." nil nil) + (autoload (quote mh-mhn-compose-insertion) "mh-mime" "\ Add a directive to insert a MIME message part from a file. This is the typical way to insert non-text parts in a message. @@ -718,6 +703,18 @@ DESCRIPTION, a line of text for the Content-description header. See also \\[mh-edit-mhn]." t nil) +(autoload (quote mh-mhn-compose-external-type) "mh-mime" "\ +Add a directive to include a MIME reference to a remote file. +The file should be available via anonymous ftp. This directive tells MH to +include a reference to a message/external-body part. + +Arguments are ACCESS-TYPE, HOST and FILENAME, which tell where to find the +file and TYPE which is the MIME Content-Type. Optional arguments include +DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES, +EXTRA-PARAMS, and COMMENT. + +See also \\[mh-edit-mhn]." t nil) + (autoload (quote mh-mhn-compose-forw) "mh-mime" "\ Add a forw directive to this message, to forward a message with MIME. This directive tells MH to include the named messages in this one. @@ -758,7 +755,9 @@ Undo the effect of \\[mh-edit-mhn] by reverting to the backup file. Optional non-nil argument NOCONFIRM means don't ask for confirmation." t nil) (autoload (quote mh-mhn-directive-present-p) "mh-mime" "\ -Check if the current buffer has text which might be a MHN directive." nil nil) +Check if the text between BEGIN and END might be a MHN directive. +The optional argument BEGIN defaults to the beginning of the buffer, while END +defaults to the the end of the buffer." nil nil) (autoload (quote mh-mml-to-mime) "mh-mime" "\ Compose MIME message from mml directives. @@ -770,6 +769,9 @@ Forward a message as attachment. The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE number." nil nil) +(autoload (quote mh-mml-query-cryptographic-method) "mh-mime" "\ +Read the cryptographic method to use." nil nil) + (autoload (quote mh-mml-attach-file) "mh-mime" "\ Attach a file to the outgoing MIME message. The file is not inserted or encoded until you send the message with @@ -781,12 +783,18 @@ This is basically `mml-attach-file' from gnus, modified such that a prefix argument yields an `inline' disposition and Content-Type is determined automatically." nil nil) -(autoload (quote mh-mml-secure-message-sign-pgpmime) "mh-mime" "\ -Add directive to encrypt/sign the entire message." t nil) +(autoload (quote mh-mml-unsecure-message) "mh-mime" "\ +Remove any secure message directives. +The IGNORE argument is not used." t nil) + +(autoload (quote mh-mml-secure-message-sign) "mh-mime" "\ +Add security directive to sign the entire message using METHOD." t nil) -(autoload (quote mh-mml-secure-message-encrypt-pgpmime) "mh-mime" "\ -Add directive to encrypt and sign the entire message. -If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." t nil) +(autoload (quote mh-mml-secure-message-encrypt) "mh-mime" "\ +Add security directive to encrypt the entire message using METHOD." t nil) + +(autoload (quote mh-mml-secure-message-signencrypt) "mh-mime" "\ +Add security directive to encrypt and sign the entire message using METHOD." t nil) (autoload (quote mh-mml-directive-present-p) "mh-mime" "\ Check if the current buffer has text which may be an MML directive." nil nil) @@ -814,6 +822,9 @@ If ARG, prompt for directory, else use that specified by the variable mh_profile directives, since this function calls on mhstore or mhn to do the actual storing." t nil) +(autoload (quote mh-toggle-mh-decode-mime-flag) "mh-mime" "\ +Toggle whether MH-E should decode MIME or not." t nil) + (autoload (quote mh-decode-message-header) "mh-mime" "\ Decode RFC2047 encoded message header fields." nil nil) @@ -840,10 +851,13 @@ Save MIME part at point." t nil) (autoload (quote mh-mime-inline-part) "mh-mime" "\ Toggle display of the raw MIME part." t nil) +(autoload (quote mh-display-with-external-viewer) "mh-mime" "\ +View MIME PART-INDEX externally." t nil) + ;;;*** -;;;### (autoloads (mh-do-search mh-pick-do-search mh-do-pick-search -;;;;;; mh-search-folder) "mh-pick" "mh-pick.el" (16625 54571)) +;;;### (autoloads (mh-do-search mh-pick-do-search mh-search-folder) +;;;;;; "mh-pick" "mh-pick.el" (16671 49140)) ;;; Generated autoloads from mh-pick.el (autoload (quote mh-search-folder) "mh-pick" "\ @@ -853,13 +867,6 @@ Add the messages found to the sequence named `search'. Argument WINDOW-CONFIG is the current window configuration and is used when the search folder is dismissed." t nil) -(autoload (quote mh-do-pick-search) "mh-pick" "\ -Find messages that match the qualifications in the current pattern buffer. -Messages are searched for in the folder named in `mh-searching-folder'. -Add the messages found to the sequence named `search'. - -This is a deprecated function and `mh-pick-do-search' should be used instead." t nil) - (autoload (quote mh-pick-do-search) "mh-pick" "\ Find messages that match the qualifications in the current pattern buffer. Messages are searched for in the folder named in `mh-searching-folder'. @@ -873,19 +880,62 @@ indexing program specified in `mh-index-program' is used." t nil) ;;;*** +;;;### (autoloads (mh-print-msg mh-ps-print-toggle-mime mh-ps-print-toggle-color +;;;;;; mh-ps-print-toggle-faces mh-ps-print-msg-show mh-ps-print-msg-file +;;;;;; mh-ps-print-msg) "mh-print" "mh-print.el" (16680 11171)) +;;; Generated autoloads from mh-print.el + +(autoload (quote mh-ps-print-msg) "mh-print" "\ +Print the messages in RANGE. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." t nil) + +(autoload (quote mh-ps-print-msg-file) "mh-print" "\ +Print to FILE the messages in RANGE. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." t nil) + +(autoload (quote mh-ps-print-msg-show) "mh-print" "\ +Print current show buffer to FILE." t nil) + +(autoload (quote mh-ps-print-toggle-faces) "mh-print" "\ +Toggle whether printing is done with faces or not." t nil) + +(autoload (quote mh-ps-print-toggle-color) "mh-print" "\ +Toggle whether color is used in printing messages." t nil) + +(autoload (quote mh-ps-print-toggle-mime) "mh-print" "\ +Cycle through available choices on how MIME parts should be printed. +The available settings are: + 1. Print only inline MIME parts. + 2. Print all MIME parts. + 3. Print no MIME parts." t nil) + +(autoload (quote mh-print-msg) "mh-print" "\ +Print RANGE on printer. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. + +The variable `mh-lpr-command-format' is used to generate the print command. +The messages are formatted by mhl. See the variable `mhl-formfile'." t nil) + +;;;*** + ;;;### (autoloads (mh-narrow-to-tick mh-toggle-tick mh-thread-refile ;;;;;; mh-thread-delete mh-thread-ancestor mh-thread-previous-sibling ;;;;;; mh-thread-next-sibling mh-thread-forget-message mh-toggle-threads ;;;;;; mh-thread-add-spaces mh-thread-update-scan-line-map mh-thread-inc ;;;;;; mh-delete-subject-or-thread mh-delete-subject mh-narrow-to-range ;;;;;; mh-narrow-to-to mh-narrow-to-cc mh-narrow-to-from mh-narrow-to-subject -;;;;;; mh-region-to-msg-list mh-interactive-range mh-range-to-msg-list -;;;;;; mh-iterate-on-range mh-iterate-on-messages-in-region mh-add-to-sequence -;;;;;; mh-notate-cur mh-notate-seq mh-map-to-seq-msgs mh-rename-seq -;;;;;; mh-translate-range mh-read-range mh-read-seq-default mh-notate-deleted-and-refiled -;;;;;; mh-widen mh-put-msg-in-seq mh-narrow-to-seq mh-msg-is-in-seq -;;;;;; mh-list-sequences mh-delete-seq) "mh-seq" "mh-seq.el" (16625 -;;;;;; 54690)) +;;;;;; mh-interactive-range mh-range-to-msg-list mh-iterate-on-range +;;;;;; mh-iterate-on-messages-in-region mh-add-to-sequence mh-notate-cur +;;;;;; mh-rename-seq mh-translate-range mh-read-range mh-read-seq-default +;;;;;; mh-notate-deleted-and-refiled mh-widen mh-put-msg-in-seq +;;;;;; mh-narrow-to-seq mh-msg-is-in-seq mh-list-sequences mh-delete-seq) +;;;;;; "mh-seq" "mh-seq.el" (16671 65286)) ;;; Generated autoloads from mh-seq.el (autoload (quote mh-delete-seq) "mh-seq" "\ @@ -895,8 +945,9 @@ Delete the SEQUENCE." t nil) List the sequences defined in the folder being visited." t nil) (autoload (quote mh-msg-is-in-seq) "mh-seq" "\ -Display the sequences that contain MESSAGE. -Default is the displayed message." t nil) +Display the sequences in which the current message appears. +Use a prefix argument to display the sequences in which another MESSAGE +appears." t nil) (autoload (quote mh-narrow-to-seq) "mh-seq" "\ Restrict display of this folder to just messages in SEQUENCE. @@ -909,10 +960,8 @@ Check the documentation of `mh-interactive-range' to see how RANGE is read in interactive use." t nil) (autoload (quote mh-widen) "mh-seq" "\ -Remove last restriction from current folder. -If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning -of the view stack thereby showing all messages that the buffer originally -contained." t nil) +Restore the previous limit. +If optional prefix argument ALL-FLAG is non-nil, remove all limits." t nil) (autoload (quote mh-notate-deleted-and-refiled) "mh-seq" "\ Notate messages marked for deletion or refiling. @@ -965,16 +1014,6 @@ In FOLDER, translate the string EXPR to a list of messages numbers." nil nil) (autoload (quote mh-rename-seq) "mh-seq" "\ Rename SEQUENCE to have NEW-NAME." t nil) -(autoload (quote mh-map-to-seq-msgs) "mh-seq" "\ -Invoke the FUNC at each message in the SEQ. -SEQ can either be a list of messages or a MH sequence. The remaining ARGS are -passed as arguments to FUNC." nil nil) - -(autoload (quote mh-notate-seq) "mh-seq" "\ -Mark the scan listing. -All messages in SEQ are marked with NOTATION at OFFSET from the beginning of -the line." nil nil) - (autoload (quote mh-notate-cur) "mh-seq" "\ Mark the MH sequence cur. In addition to notating the current message with `mh-note-cur' the function @@ -1019,37 +1058,44 @@ RANGE-PROMPT. A list of messages in that range is returned. If a MH range is given, say something like last:20, then a list containing the messages in that range is returned. +If DEFAULT non-nil then it is returned. + Otherwise, the message number at point is returned. This function is usually used with `mh-iterate-on-range' in order to provide a uniform interface to MH-E functions." nil nil) -(autoload (quote mh-region-to-msg-list) "mh-seq" "\ -Return a list of messages within the region between BEGIN and END." nil nil) - (autoload (quote mh-narrow-to-subject) "mh-seq" "\ -Narrow to a sequence containing all following messages with same subject." t nil) +Limit to messages with same subject. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil) (autoload (quote mh-narrow-to-from) "mh-seq" "\ -Limit to messages with the same From header field as the message at point. -With a prefix argument, prompt for the regular expression, REGEXP given to -pick." t nil) +Limit to messages with the same `From:' field. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil) (autoload (quote mh-narrow-to-cc) "mh-seq" "\ -Limit to messages with the same Cc header field as the message at point. -With a prefix argument, prompt for the regular expression, REGEXP given to -pick." t nil) +Limit to messages with the same `Cc:' field. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil) (autoload (quote mh-narrow-to-to) "mh-seq" "\ -Limit to messages with the same To header field as the message at point. -With a prefix argument, prompt for the regular expression, REGEXP given to -pick." t nil) +Limit to messages with the same `To:' field. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil) (autoload (quote mh-narrow-to-range) "mh-seq" "\ Limit to messages in RANGE. Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use." t nil) +interactive use. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil) (autoload (quote mh-delete-subject) "mh-seq" "\ Mark all following messages with same subject to be deleted. @@ -1103,14 +1149,15 @@ Mark current message and all its children for refiling to FOLDER." t nil) Toggle tick mark of all messages in RANGE." t nil) (autoload (quote mh-narrow-to-tick) "mh-seq" "\ -Restrict display of this folder to just messages in `mh-tick-seq'. +Limit to messages in `mh-tick-seq'. + Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." t nil) ;;;*** ;;;### (autoloads (mh-speed-add-folder mh-speed-invalidate-map mh-speed-flists ;;;;;; mh-speed-view mh-speed-toggle mh-folder-speedbar-buttons) -;;;;;; "mh-speed" "mh-speed.el" (16625 54721)) +;;;;;; "mh-speed" "mh-speed.el" (16665 53793)) ;;; Generated autoloads from mh-speed.el (autoload (quote mh-folder-speedbar-buttons) "mh-speed" "\ @@ -1145,31 +1192,24 @@ The function invalidates the latest ancestor that is present." nil nil) ;;;*** -;;;### (autoloads (mh-get-msg-num mh-goto-address-find-address-at-point) -;;;;;; "mh-utils" "mh-utils.el" (16625 54979)) -;;; Generated autoloads from mh-utils.el - -(autoload (quote mh-goto-address-find-address-at-point) "mh-utils" "\ -Find e-mail address around or before point. -Then search backwards to beginning of line for the start of an e-mail -address. If no e-mail address found, return nil." nil nil) - -(autoload (quote mh-get-msg-num) "mh-utils" "\ -Return the message number of the displayed message. -If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is -not pointing to a message." nil nil) - -;;;*** - ;;;### (autoloads (mh-alias-apropos mh-alias-add-address-under-point -;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-from-has-no-alias-p +;;;;;; mh-alias-grab-from-field mh-alias-add-alias mh-alias-for-from-p ;;;;;; mh-alias-address-to-alias mh-alias-letter-expand-alias mh-alias-minibuffer-confirm-address ;;;;;; mh-read-address mh-alias-reload-maybe mh-alias-reload) "mh-alias" -;;;;;; "mh-alias.el" (16625 53006)) +;;;;;; "mh-alias.el" (16671 49382)) ;;; Generated autoloads from mh-alias.el (autoload (quote mh-alias-reload) "mh-alias" "\ -Load MH aliases into `mh-alias-alist'." t nil) +Reload MH aliases. + +Since aliases are updated frequently, MH-E will reload aliases automatically +whenever an alias lookup occurs if an alias source (a file listed in your +`Aliasfile:' profile component and your password file if variable +`mh-alias-local-users' is non-nil) has changed. However, you can reload your +aliases manually by calling this command directly. + +The value of `mh-alias-reloaded-hook' is a list of functions to be called, +with no arguments, after the aliases have been loaded." t nil) (autoload (quote mh-alias-reload-maybe) "mh-alias" "\ Load new MH aliases." nil nil) @@ -1186,26 +1226,25 @@ Expand mail alias before point." nil nil) (autoload (quote mh-alias-address-to-alias) "mh-alias" "\ Return the ADDRESS alias if defined, or nil." nil nil) -(autoload (quote mh-alias-from-has-no-alias-p) "mh-alias" "\ -Return t is From has no current alias set. -In the exceptional situation where there isn't a From header in the message the -function returns nil." nil nil) +(autoload (quote mh-alias-for-from-p) "mh-alias" "\ +Return t if sender's address has a corresponding alias." nil nil) (autoload (quote mh-alias-add-alias) "mh-alias" "\ *Add ALIAS for ADDRESS in personal alias file. -Prompts for confirmation if the address already has an alias. -If the alias is already is use, `mh-alias-add-alias-to-file' will prompt." t nil) +This function prompts you for an alias and address. If the alias exists +already, you will have the choice of inserting the new alias before or after +the old alias. In the former case, this alias will be used when sending mail +to this alias. In the latter case, the alias serves as an additional folder +name hint when filing messages." t nil) (autoload (quote mh-alias-grab-from-field) "mh-alias" "\ -*Add ALIAS for ADDRESS in personal alias file. -Prompts for confirmation if the alias is already in use or if the address -already has an alias." t nil) +*Add alias for the sender of the current message." t nil) (autoload (quote mh-alias-add-address-under-point) "mh-alias" "\ -Insert an alias for email address under point." t nil) +Insert an alias for address under point." t nil) (autoload (quote mh-alias-apropos) "mh-alias" "\ -Show all aliases that match REGEXP either in name or content." t nil) +Show all aliases or addresses that match REGEXP." t nil) ;;;*** diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 91cbcec0c06..72cb654dedd 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -34,7 +34,7 @@ ;;; Code: -(require 'mh-utils) +(eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-comp) (require 'gnus-util) @@ -46,8 +46,7 @@ (autoload 'gnus-eval-format "gnus-spec") (autoload 'widget-convert-button "wid-edit") (autoload 'message-options-set-recipient "message") -(autoload 'mml-secure-message-sign-pgpmime "mml-sec") -(autoload 'mml-secure-message-encrypt-pgpmime "mml-sec") +(autoload 'mml-unsecure-message "mml-sec") (autoload 'mml-minibuffer-read-file "mml") (autoload 'mml-minibuffer-read-description "mml") (autoload 'mml-insert-empty-tag "mml") @@ -82,7 +81,7 @@ If any of the optional arguments are absent, they are prompted for." (read-string "Forw Content-description: ") (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) (read-string (format "Messages%s: " - (if mh-sent-from-msg + (if (numberp mh-sent-from-msg) (format " [%d]" mh-sent-from-msg) ""))))) (if (equal mh-compose-insertion 'gnus) @@ -114,6 +113,7 @@ MH profile.") ;; the variable, so things should work exactly as before. (defvar mh-have-file-command) +;;;###mh-autoload (defun mh-have-file-command () "Return t if 'file' command is on the system. 'file -i' is used to get MIME type of composition insertion." @@ -129,7 +129,8 @@ MH profile.") (defvar mh-file-mime-type-substitutions '(("application/msword" "\.xls" "application/ms-excel") - ("application/msword" "\.ppt" "application/ms-powerpoint")) + ("application/msword" "\.ppt" "application/ms-powerpoint") + ("text/plain" "\.vcf" "text/x-vcard")) "Substitutions to make for Content-Type returned from file command. The first element is the Content-Type returned by the file command. The second element is a regexp matching the file name, usually the extension. @@ -151,6 +152,7 @@ Substitutions are made from the `mh-file-mime-type-substitutions' variable." (setq subst (cdr subst)))) answer)) +;;;###mh-autoload (defun mh-file-mime-type (filename) "Return MIME type of FILENAME from file command. Returns nil if file command not on system." @@ -192,12 +194,38 @@ Returns nil if file command not on system." ("message/external-body") ("message/partial") ("message/rfc822") ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers") - ("text/richtext") ("text/xml") + ("text/richtext") ("text/x-vcard") ("text/xml") ("video/mpeg") ("video/quicktime")) "Legal MIME content types. See documentation for \\[mh-edit-mhn].") +;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One: +;; Format of Internet Message Bodies. +;; RFC 2046 - Multipurpose Internet Mail Extensions (MIME) Part Two: +;; Media Types. +;; RFC 2049 - Multipurpose Internet Mail Extensions (MIME) Part Five: +;; Conformance Criteria and Examples. +;; RFC 2017 - Definition of the URL MIME External-Body Access-Type +;; RFC 1738 - Uniform Resource Locators (URL) +(defvar mh-access-types + '(("anon-ftp") ; RFC2046 Anonymous File Transfer Protocol + ("file") ; RFC1738 Host-specific file names + ("ftp") ; RFC2046 File Transfer Protocol + ("gopher") ; RFC1738 The Gopher Protocol + ("http") ; RFC1738 Hypertext Transfer Protocol + ("local-file") ; RFC2046 Local file access + ("mail-server") ; RFC2046 mail-server Electronic mail address + ("mailto") ; RFC1738 Electronic mail address + ("news") ; RFC1738 Usenet news + ("nntp") ; RFC1738 Usenet news using NNTP access + ("propspero") ; RFC1738 Prospero Directory Service + ("telnet") ; RFC1738 Telnet + ("tftp") ; RFC2046 Trivial File Transfer Protocol + ("url") ; RFC2017 URL scheme MIME access-type Protocol + ("wais")) ; RFC1738 Wide Area Information Servers + "Legal MIME access-type values.") + ;;;###mh-autoload (defun mh-mhn-compose-insertion (filename type description attributes) "Add a directive to insert a MIME message part from a file. @@ -286,7 +314,7 @@ See also \\[mh-edit-mhn]." "type=tar; conversions=x-compress" "mode=image")) - +;;;###mh-autoload (defun mh-mhn-compose-external-type (access-type host filename type &optional description attributes extra-params @@ -301,6 +329,18 @@ DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES, EXTRA-PARAMS, and COMMENT. See also \\[mh-edit-mhn]." + (interactive (list + (completing-read "Access Type: " mh-access-types) + (read-string "Remote host: ") + (read-string "Remote url-path: ") + (completing-read "Content-Type: " + (if (fboundp 'mailcap-mime-types) + (mapcar 'list (mailcap-mime-types)) + mh-mime-content-types)) + (if current-prefix-arg (read-string "Content-description: ")) + (if current-prefix-arg (read-string "Attributes: ")) + (if current-prefix-arg (read-string "Extra Parameters: ")) + (if current-prefix-arg (read-string "Comment: ")))) (beginning-of-line) (insert "#@" type) (and attributes @@ -314,7 +354,9 @@ See also \\[mh-edit-mhn]." (insert "access-type=" access-type "; ") (insert "site=" host) (insert "; name=" (file-name-nondirectory filename)) - (insert "; directory=\"" (file-name-directory filename) "\"") + (let ((directory (file-name-directory filename))) + (and directory + (insert "; directory=\"" directory "\""))) (and extra-params (insert "; " extra-params)) (insert "\n")) @@ -332,7 +374,7 @@ See also \\[mh-edit-mhn]." (read-string "Forw Content-description: ") (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) (read-string (format "Messages%s: " - (if mh-sent-from-msg + (if (numberp mh-sent-from-msg) (format " [%d]" mh-sent-from-msg) ""))))) (beginning-of-line) @@ -349,7 +391,7 @@ See also \\[mh-edit-mhn]." (let ((start (point))) (insert " " messages) (subst-char-in-region start (point) ?, ? )) - (if mh-sent-from-msg + (if (numberp mh-sent-from-msg) (insert " " (int-to-string mh-sent-from-msg)))) (insert "\n")) @@ -380,10 +422,11 @@ arguments, after performing the conversion. The mhn program is part of MH version 6.8 or later." (interactive "*P") + (mh-mhn-quote-unescaped-sharp) (save-buffer) (message "mhn editing...") (cond - (mh-nmh-flag + ((mh-variant-p 'nmh) (mh-exec-cmd-error nil "mhbuild" (if extra-args mh-mhn-args) buffer-file-name)) (t @@ -393,6 +436,19 @@ The mhn program is part of MH version 6.8 or later." (message "mhn editing...done") (run-hooks 'mh-edit-mhn-hook)) +(defun mh-mhn-quote-unescaped-sharp () + "Quote `#' characters that haven't been quoted for `mhbuild'. +If the `#' character is present in the first column, but it isn't part of a +MHN directive then `mhbuild' gives an error. This function will quote all such +characters." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^#" nil t) + (beginning-of-line) + (unless (mh-mhn-directive-present-p (point) (line-end-position)) + (insert "#")) + (goto-char (line-end-position))))) + ;;;###mh-autoload (defun mh-revert-mhn-edit (noconfirm) "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file. @@ -422,18 +478,24 @@ Optional non-nil argument NOCONFIRM means don't ask for confirmation." (after-find-file nil))) ;;;###mh-autoload -(defun mh-mhn-directive-present-p () - "Check if the current buffer has text which might be a MHN directive." +(defun mh-mhn-directive-present-p (&optional begin end) + "Check if the text between BEGIN and END might be a MHN directive. +The optional argument BEGIN defaults to the beginning of the buffer, while END +defaults to the the end of the buffer." + (unless begin (setq begin (point-min))) + (unless end (setq end (point-max))) (save-excursion (block 'search-for-mhn-directive - (goto-char (point-min)) - (while (re-search-forward "^#" nil t) + (goto-char begin) + (while (re-search-forward "^#" end t) (let ((s (buffer-substring-no-properties (point) (line-end-position)))) (cond ((equal s "")) ((string-match "^forw[ \t\n]+" s) (return-from 'search-for-mhn-directive t)) (t (let ((first-token (car (split-string s "[ \t;@]")))) - (when (string-match mh-media-type-regexp first-token) + (when (and first-token + (string-match mh-media-type-regexp + first-token)) (return-from 'search-for-mhn-directive t))))))) nil))) @@ -450,14 +512,23 @@ function may be called manually before sending the draft as well." (require 'message) (when mh-gnus-pgp-support-flag ;; This is only needed for PGP (message-options-set-recipient)) - (mml-to-mime)) + (let ((saved-text (buffer-string)) + (buffer (current-buffer)) + (modified-flag (buffer-modified-p))) + (condition-case err (mml-to-mime) + (error + (with-current-buffer buffer + (delete-region (point-min) (point-max)) + (insert saved-text) + (set-buffer-modified-p modified-flag)) + (error (error-message-string err)))))) ;;;###mh-autoload (defun mh-mml-forward-message (description folder message) "Forward a message as attachment. The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE number." - (let ((msg (if (equal message "") + (let ((msg (if (and (equal message "") (numberp mh-sent-from-msg)) mh-sent-from-msg (car (read-from-string message))))) (cond ((integerp msg) @@ -473,6 +544,19 @@ number." description))) (t (error "The message number, %s is not a integer!" msg))))) +(defvar mh-mml-cryptographic-method-history ()) + +;;;###mh-autoload +(defun mh-mml-query-cryptographic-method () + "Read the cryptographic method to use." + (if current-prefix-arg + (let ((def (or (car mh-mml-cryptographic-method-history) + mh-mml-method-default))) + (completing-read (format "Method: [%s] " def) + '(("pgp") ("pgpmime") ("smime")) + nil t nil 'mh-mml-cryptographic-method-history def)) + mh-mml-method-default)) + ;;;###mh-autoload (defun mh-mml-attach-file (&optional disposition) "Attach a file to the outgoing MIME message. @@ -499,22 +583,58 @@ automatically." (mml-insert-empty-tag 'part 'type type 'filename file 'disposition dispos 'description description))) -;;;###mh-autoload -(defun mh-mml-secure-message-sign-pgpmime () - "Add directive to encrypt/sign the entire message." - (interactive) +(defvar mh-identity-pgg-default-user-id) + +(defun mh-secure-message (method mode &optional identity) + "Add directive to Encrypt/Sign an entire message. +METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\". +MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\". +IDENTITY is optionally the default-user-id to use." (if (not mh-gnus-pgp-support-flag) (error "Sorry. Your version of gnus does not support PGP/GPG") - (mml-secure-message-sign-pgpmime))) + ;; Check the arguments + (let ((valid-methods (list "pgpmime" "pgp" "smime")) + (valid-modes (list "sign" "encrypt" "signencrypt" "none"))) + (if (not (member method valid-methods)) + (error (format "Sorry. METHOD \"%s\" is invalid." method))) + (if (not (member mode valid-modes)) + (error (format "Sorry. MODE \"%s\" is invalid" mode))) + (mml-unsecure-message) + (if (not (string= mode "none")) + (save-excursion + (goto-char (point-min)) + (mh-goto-header-end 1) + (if mh-identity-pgg-default-user-id + (mml-insert-tag 'secure 'method method 'mode mode + 'sender mh-identity-pgg-default-user-id) + (mml-insert-tag 'secure 'method method 'mode mode))))))) ;;;###mh-autoload -(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign) - "Add directive to encrypt and sign the entire message. -If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)." +(defun mh-mml-unsecure-message (&optional ignore) + "Remove any secure message directives. +The IGNORE argument is not used." (interactive "P") (if (not mh-gnus-pgp-support-flag) (error "Sorry. Your version of gnus does not support PGP/GPG") - (mml-secure-message-encrypt-pgpmime dontsign))) + (mml-unsecure-message))) + +;;;###mh-autoload +(defun mh-mml-secure-message-sign (method) + "Add security directive to sign the entire message using METHOD." + (interactive (list (mh-mml-query-cryptographic-method))) + (mh-secure-message method "sign" mh-identity-pgg-default-user-id)) + +;;;###mh-autoload +(defun mh-mml-secure-message-encrypt (method) + "Add security directive to encrypt the entire message using METHOD." + (interactive (list (mh-mml-query-cryptographic-method))) + (mh-secure-message method "encrypt" mh-identity-pgg-default-user-id)) + +;;;###mh-autoload +(defun mh-mml-secure-message-signencrypt (method) + "Add security directive to encrypt and sign the entire message using METHOD." + (interactive (list (mh-mml-query-cryptographic-method))) + (mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id)) ;;;###mh-autoload (defun mh-mml-directive-present-p () @@ -667,19 +787,19 @@ actual storing." (folder (if (eq major-mode 'mh-show-mode) mh-show-folder-buffer mh-current-folder)) - (command (if mh-nmh-flag "mhstore" "mhn")) + (command (if (mh-variant-p 'nmh) "mhstore" "mhn")) (directory (cond ((and (or arg (equal nil mh-mime-save-parts-default-directory) (equal t mh-mime-save-parts-default-directory)) (not mh-mime-save-parts-directory)) - (read-file-name "Store in what directory? " nil nil t nil)) + (read-file-name "Store in directory: " nil nil t nil)) ((and (or arg (equal t mh-mime-save-parts-default-directory)) mh-mime-save-parts-directory) (read-file-name (format - "Store in what directory? [%s] " + "Store in directory: [%s] " mh-mime-save-parts-directory) "" mh-mime-save-parts-directory t "")) ((stringp mh-mime-save-parts-default-directory) @@ -689,7 +809,7 @@ actual storing." (if (and (equal directory "") mh-mime-save-parts-directory) (setq directory mh-mime-save-parts-directory)) (if (not (file-directory-p directory)) - (message "No directory specified.") + (message "No directory specified") (if (equal nil mh-mime-save-parts-default-directory) (setq mh-mime-save-parts-directory directory)) (save-excursion @@ -732,6 +852,14 @@ If message has been encoded for transfer take that into account." (car ct)))))) ;;;###mh-autoload +(defun mh-toggle-mh-decode-mime-flag () + "Toggle whether MH-E should decode MIME or not." + (interactive) + (setq mh-decode-mime-flag (not mh-decode-mime-flag)) + (mh-show nil t) + (message (format "(setq mh-decode-mime-flag %s)" mh-decode-mime-flag))) + +;;;###mh-autoload (defun mh-decode-message-header () "Decode RFC2047 encoded message header fields." (when mh-decode-mime-flag @@ -766,17 +894,18 @@ displayed." (mh-mime-handles (mh-buffer-data)))) (unless handles (mh-decode-message-body))) - (when (and handles - (or (not (stringp (car handles))) (cdr handles))) - ;; Goto start of message body - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (goto-char (point-max))) + (cond ((and handles + (or (not (stringp (car handles))) (cdr handles))) + ;; Goto start of message body + (goto-char (point-min)) + (or (search-forward "\n\n" nil t) (goto-char (point-max))) - ;; Delete the body - (delete-region (point) (point-max)) + ;; Delete the body + (delete-region (point) (point-max)) - ;; Display the MIME handles - (mh-mime-display-part handles))) + ;; Display the MIME handles + (mh-mime-display-part handles)) + (t (mh-signature-highlight)))) (error (message "Please report this error. The error message is:\n %s" (error-message-string err)) @@ -874,7 +1003,7 @@ This is only useful if a Content-Disposition header is not present." (save-restriction (widen) (goto-char (point-min)) - (not (re-search-forward "^-- $" nil t))))))) + (not (mh-signature-separator-p))))))) (defun mh-mime-display-single (handle) "Display a leaf node, HANDLE in the MIME tree." @@ -904,7 +1033,8 @@ This is only useful if a Content-Disposition header is not present." (insert "\n") (mh-insert-mime-button handle (mh-mime-part-index handle) nil)) ((and displayp (not mh-display-buttons-for-inline-parts-flag)) - (or (mm-display-part handle) (mm-display-part handle))) + (or (mm-display-part handle) (mm-display-part handle)) + (mh-signature-highlight handle)) ((and displayp mh-display-buttons-for-inline-parts-flag) (insert "\n") (mh-insert-mime-button handle (mh-mime-part-index handle) nil) @@ -912,6 +1042,28 @@ This is only useful if a Content-Disposition header is not present." (mh-mm-display-part handle))) (goto-char (point-max))))) +(defun mh-signature-highlight (&optional handle) + "Highlight message signature in HANDLE. +The optional argument, HANDLE is a MIME handle if the function is being used +to highlight the signature in a MIME part." + (let ((regexp + (cond ((not handle) "^-- $") + ((not (and (equal (mm-handle-media-supertype handle) "text") + (equal (mm-handle-media-subtype handle) "html"))) + "^-- $") + ((eq (mh-mm-text-html-renderer) 'lynx) "^ --$") + (t "^--$")))) + (save-excursion + (goto-char (point-max)) + (when (re-search-backward regexp nil t) + (mh-do-in-gnu-emacs + (let ((ov (make-overlay (point) (point-max)))) + (overlay-put ov 'face 'mh-show-signature-face) + (overlay-put ov 'evaporate t))) + (mh-do-in-xemacs + (set-extent-property (make-extent (point) (point-max)) + 'face 'mh-show-signature-face)))))) + (mh-do-in-xemacs (defvar dots) (defvar type)) @@ -954,7 +1106,9 @@ like \"K v\" which operate on individual MIME parts." :action 'mh-widget-press-button :button-keymap mh-mime-button-map :help-echo - "Mouse-2 click or press RET (in show buffer) to toggle display"))) + "Mouse-2 click or press RET (in show buffer) to toggle display") + (dolist (ov (mh-funcall-if-exists overlays-in begin end)) + (mh-funcall-if-exists overlay-put ov 'evaporate t)))) ;; There is a bug in Gnus inline image display due to which an extra line ;; gets inserted every time it is viewed. To work around that problem we are @@ -1009,7 +1163,8 @@ like \"K v\" which operate on individual MIME parts." (when (eq mh-highlight-citation-p 'gnus) (mh-gnus-article-highlight-citation)) (mh-display-smileys) - (mh-display-emphasis)) + (mh-display-emphasis) + (mh-signature-highlight handle)) (setq region (cons (progn (goto-char (point-min)) (point-marker)) (progn (goto-char (point-max)) @@ -1098,6 +1253,31 @@ button." (goto-char point) (set-buffer-modified-p nil))) +;;;###mh-autoload +(defun mh-display-with-external-viewer (part-index) + "View MIME PART-INDEX externally." + (interactive "P") + (when (consp part-index) (setq part-index (car part-index))) + (mh-folder-mime-action + part-index + #'(lambda () + (let* ((part (get-text-property (point) 'mh-data)) + (type (mm-handle-media-type part)) + (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x)))) + (mailcap-mime-info type 'all))) + (def (caar methods)) + (prompt (format "Viewer: %s" (if def (format "[%s] " def) ""))) + (method (completing-read prompt methods nil nil nil nil def)) + (folder mh-show-folder-buffer) + (buffer-read-only nil)) + (when (string-match "^[^% \t]+$" method) + (setq method (concat method " %s"))) + (flet ((mm-handle-set-external-undisplayer (handle function) + (mh-handle-set-external-undisplayer folder handle function))) + (unwind-protect (mm-display-external part method) + (set-buffer-modified-p nil))))) + nil)) + (defun mh-widget-press-button (widget el) "Callback for widget, WIDGET. Parameter EL is unused." @@ -1106,9 +1286,9 @@ Parameter EL is unused." (defun mh-mime-display-security (handle) "Display PGP encrypted/signed message, HANDLE." - (insert "\n") (save-restriction (narrow-to-region (point) (point)) + (insert "\n") (mh-insert-mime-security-button handle) (mh-mime-display-mixed (cdr handle)) (insert "\n") @@ -1116,9 +1296,7 @@ Parameter EL is unused." mh-mime-security-button-end-line-format)) (mh-insert-mime-security-button handle)) (mm-set-handle-multipart-parameter - handle 'mh-region - (cons (set-marker (make-marker) (point-min)) - (set-marker (make-marker) (point-max)))))) + handle 'mh-region (cons (point-min-marker) (point-max-marker))))) ;;; I rewrote the security part because Gnus doesn't seem to ever minimize ;;; the button. That is once the mime-security button is pressed there seems @@ -1149,8 +1327,22 @@ Parameter EL is unused." (defun mh-mime-security-press-button (handle) "Callback from security button for part HANDLE." - (when (mm-handle-multipart-ctl-parameter handle 'gnus-info) - (mh-mime-security-show-details handle))) + (if (mm-handle-multipart-ctl-parameter handle 'gnus-info) + (mh-mime-security-show-details handle) + (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region)) + point) + (setq point (point)) + (goto-char (car region)) + (delete-region (car region) (cdr region)) + (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer) + (let* ((mm-verify-option 'known) + (mm-decrypt-option 'known) + (new (mm-possibly-verify-or-decrypt (cdr handle) handle))) + (unless (eq new (cdr handle)) + (mm-destroy-parts (cdr handle)) + (setcdr handle new)))) + (mh-mime-display-security handle) + (goto-char point)))) ;; These variables should already be initialized in mm-decode.el if we have a ;; recent enough Gnus. The defvars are here to avoid compiler warnings. @@ -1191,6 +1383,8 @@ Parameter EL is unused." :action 'mh-widget-press-button :button-keymap mh-mime-security-button-map :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.") + (dolist (ov (mh-funcall-if-exists overlays-in begin end)) + (mh-funcall-if-exists overlay-put ov 'evaporate t)) (when (equal info "Failed") (let* ((type (if (equal (car handle) "multipart/signed") "verification" "decryption")) @@ -1204,8 +1398,8 @@ The function decodes the message and displays it. It avoids decoding the same message multiple times." (let ((b (point)) (clean-message-header mh-clean-message-header-flag) - (invisible-headers mh-invisible-headers) - (visible-headers mh-visible-headers)) + (invisible-headers mh-invisible-header-fields-compiled) + (visible-headers nil)) (save-excursion (save-restriction (narrow-to-region b b) diff --git a/lisp/mh-e/mh-pick.el b/lisp/mh-e/mh-pick.el index a888f02154f..b92a98f26cc 100644 --- a/lisp/mh-e/mh-pick.el +++ b/lisp/mh-e/mh-pick.el @@ -1,6 +1,6 @@ ;;; mh-pick.el --- make a search pattern and search for a message in MH-E -;; Copyright (C) 1993, 1995, 2001, 2003 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1995, 2001, 2003, 2004 Free Software Foundation, Inc. ;; Author: Bill Wohler <wohler@newt.com> ;; Maintainer: Bill Wohler <wohler@newt.com> @@ -32,6 +32,8 @@ ;;; Code: +(eval-when-compile (require 'mh-acros)) +(mh-require-cl) (require 'mh-e) (require 'easymenu) (require 'gnus-util) @@ -44,6 +46,9 @@ (defvar mh-searching-folder nil) ;Folder this pick is searching. (defvar mh-searching-function nil) +(defconst mh-pick-single-dash '(cc date from subject to) + "Search components that are supported by single-dash option in pick.") + ;;;###mh-autoload (defun mh-search-folder (folder window-config) "Search FOLDER for messages matching a pattern. @@ -139,16 +144,6 @@ with no arguments, upon entry to this mode. (run-hooks 'mh-pick-mode-hook)) ;;;###mh-autoload -(defun mh-do-pick-search () - "Find messages that match the qualifications in the current pattern buffer. -Messages are searched for in the folder named in `mh-searching-folder'. -Add the messages found to the sequence named `search'. - -This is a deprecated function and `mh-pick-do-search' should be used instead." - (interactive) - (mh-pick-do-search)) - -;;;###mh-autoload (defun mh-pick-do-search () "Find messages that match the qualifications in the current pattern buffer. Messages are searched for in the folder named in `mh-searching-folder'. @@ -260,6 +255,13 @@ COMPONENT is the component to search." "-rbrace")) (t (error "Unknown operator '%s' seen" (car expr))))) +;; All implementations of pick have special options -cc, -date, -from and +;; -subject that allow to search for corresponding components. Any other +;; component is searched using option --COMPNAME, for example: `pick +;; --x-mailer mh-e'. Mailutils `pick' supports this option using a certain +;; kludge, but it prefers the following syntax for this purpose: +;; `--component=COMPNAME --pattern=PATTERN'. +;; -- Sergey Poznyakoff, Aug 2003 (defun mh-pick-regexp-builder (pattern-list) "Generate pick search expression from PATTERN-LIST." (let ((result ())) @@ -267,9 +269,18 @@ COMPONENT is the component to search." (when (cdr pattern) (setq result `(,@result "-and" "-lbrace" ,@(mh-pick-construct-regexp - (cdr pattern) (if (car pattern) - (format "-%s" (car pattern)) - "-search")) + (if (and (mh-variant-p 'mu-mh) (car pattern)) + (format "--pattern=%s" (cdr pattern)) + (cdr pattern)) + (if (car pattern) + (cond + ((mh-variant-p 'mu-mh) + (format "--component=%s" (car pattern))) + ((member (car pattern) mh-pick-single-dash) + (format "-%s" (car pattern))) + (t + (format "--%s" (car pattern)))) + "-search")) "-rbrace")))) (cdr result))) diff --git a/lisp/mh-e/mh-print.el b/lisp/mh-e/mh-print.el new file mode 100644 index 00000000000..7539e455919 --- /dev/null +++ b/lisp/mh-e/mh-print.el @@ -0,0 +1,279 @@ +;;; mh-print.el --- MH-E printing support + +;; Copyright (C) 2003, 2004 Free Software Foundation, Inc. + +;; Author: Jeffrey C Honig <jch@honig.net> +;; Maintainer: Bill Wohler <wohler@newt.com> +;; Keywords: mail +;; See: mh-e.el + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: +;; Pp Print to lpr | Default inline settings +;; Pf Print to file | Generate a postscript file +;; Ps Print show buffer | Fails if no show buffer +;; +;; PA Toggle inline/attachments +;; PC Toggle color +;; PF Toggle faces + +;;; Change Log: + +;;; Code: + +(eval-when-compile (require 'mh-acros)) +(mh-require-cl) +(require 'ps-print) +(require 'mh-utils) +(require 'mh-funcs) +(eval-when-compile (require 'mh-seq)) + +(defvar mh-ps-print-mime nil + "Control printing of MIME parts. +The three possible states are: + 1. nil to not print inline parts + 2. t to print inline parts + 3. non-zero to print inline parts and attachments") + +(defvar mh-ps-print-color-option ps-print-color-p + "MH-E's version of `\\[ps-print-color-p]'.") + +(defvar mh-ps-print-func 'ps-spool-buffer-with-faces + "Function to use to spool a buffer. +Sensible choices are the functions `ps-spool-buffer' and +`ps-spool-buffer-with-faces'.") + +;; XXX - If buffer is already being displayed, use that buffer +;; XXX - What about showing MIME content? +;; XXX - Default print buffer is bogus +(defun mh-ps-spool-buffer (buffer) + "Send BUFFER to printer queue." + (message (format "mh-ps-spool-buffer %s" buffer)) + (save-excursion + (set-buffer buffer) + (let ((ps-print-color-p mh-ps-print-color-option) + (ps-left-header + (list + (concat "(" + (mh-get-header-field "Subject:") ")") + (concat "(" + (mh-get-header-field "From:") ")"))) + (ps-right-header + (list + "/pagenumberstring load" + (concat "(" + (mh-get-header-field "Date:") ")")))) + (funcall mh-ps-print-func)))) + +(defun mh-ps-spool-a-msg (msg buffer) + "Print MSG. +First the message is decoded in BUFFER before the results are sent to the +printer." + (message (format "mh-ps-spool-a-msg msg %s buffer %s" + msg buffer)) + (let ((mh-show-buffer mh-show-buffer) + (folder mh-current-folder) + ;; The following is commented out because + ;; `clean-message-header-flag' isn't used anywhere. I + ;; commented rather than deleted in case somebody had some + ;; future plans for it. --SY. + ;(clean-message-header-flag mh-clean-message-header-flag) + ) + (unwind-protect + (progn + (setq mh-show-buffer buffer) + (save-excursion + ;; + ;; XXX - Use setting of mh-ps-print-mime + ;; + (mh-display-msg msg folder) + (mh-ps-spool-buffer mh-show-buffer) + (kill-buffer mh-show-buffer)))))) + +;;;###mh-autoload +(defun mh-ps-print-msg (range) + "Print the messages in RANGE. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." + (interactive (list (mh-interactive-range "Print"))) + (message (format "mh-ps-print-msg range %s keys %s" + range (this-command-keys))) + (mh-iterate-on-range msg range + (let ((buffer (get-buffer-create mh-temp-buffer))) + (unwind-protect + (mh-ps-spool-a-msg msg buffer) + (kill-buffer buffer))) + (mh-notate nil mh-note-printed mh-cmd-note)) + (ps-despool nil)) + +(defun mh-ps-print-preprint (prefix-arg) + "Replacement for `ps-print-preprint'. +The original function does not handle the fact that MH folders are directories +nicely, when generating the default file name. This function works around +that. The function is passed the interactive PREFIX-ARG." + (let ((buffer-file-name (format "/tmp/%s" (substring (buffer-name) 1)))) + (ps-print-preprint prefix-arg))) + +;;;###mh-autoload +(defun mh-ps-print-msg-file (file range) + "Print to FILE the messages in RANGE. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use." + (interactive (list + (mh-ps-print-preprint 1) + (mh-interactive-range "Print"))) + (mh-iterate-on-range msg range + (let ((buffer (get-buffer-create mh-temp-buffer))) + (unwind-protect + (mh-ps-spool-a-msg msg buffer) + (kill-buffer buffer))) + (mh-notate nil mh-note-printed mh-cmd-note)) + (ps-despool file)) + +;;;###mh-autoload +(defun mh-ps-print-msg-show (file) + "Print current show buffer to FILE." + (interactive (list (mh-ps-print-preprint current-prefix-arg))) + (message (format "mh-ps-print-msg-show file %s keys %s mh-show-buffer %s" + file (this-command-keys) mh-show-buffer)) + (let ((msg (mh-get-msg-num t)) + (folder mh-current-folder) + (show-buffer mh-show-buffer) + (show-window (get-buffer-window mh-show-buffer))) + (if (and show-buffer show-window) + (mh-in-show-buffer (show-buffer) + (if (equal (mh-msg-filename msg folder) buffer-file-name) + (progn + (mh-ps-spool-buffer show-buffer) + (ps-despool file)) + (message "Current message is not being shown(1)."))) + (message "Current message is not being shown(2).")))) + +;;;###mh-autoload +(defun mh-ps-print-toggle-faces () + "Toggle whether printing is done with faces or not." + (interactive) + (if (eq mh-ps-print-func 'ps-spool-buffer-with-faces) + (progn + (setq mh-ps-print-func 'ps-spool-buffer) + (message "Printing without faces")) + (setq mh-ps-print-func 'ps-spool-buffer-with-faces) + (message "Printing with faces"))) + +;;;###mh-autoload +(defun mh-ps-print-toggle-color () + "Toggle whether color is used in printing messages." + (interactive) + (if (eq mh-ps-print-color-option nil) + (progn + (setq mh-ps-print-color-option 'black-white) + (message "Colors will be printed as black & white.")) + (if (eq mh-ps-print-color-option 'black-white) + (progn + (setq mh-ps-print-color-option t) + (message "Colors will be printed.")) + (setq mh-ps-print-color-option nil) + (message "Colors will not be printed.")))) + +;;; XXX: Check option 3. Documentation doesn't sound right. +;;;###mh-autoload +(defun mh-ps-print-toggle-mime () + "Cycle through available choices on how MIME parts should be printed. +The available settings are: + 1. Print only inline MIME parts. + 2. Print all MIME parts. + 3. Print no MIME parts." + (interactive) + (if (eq mh-ps-print-mime nil) + (progn + (setq mh-ps-print-mime t) + (message "Inline parts will be printed, attachments will not be printed.")) + (if (eq mh-ps-print-mime t) + (progn + (setq mh-ps-print-mime 1) + (message "Both Inline parts and attachments will be printed.")) + (setq mh-ps-print-mime nil) + (message "Neither inline parts nor attachments will be printed.")))) + +;;; Old non-PS based printing +;;;###mh-autoload +(defun mh-print-msg (range) + "Print RANGE on printer. + +Check the documentation of `mh-interactive-range' to see how RANGE is read in +interactive use. + +The variable `mh-lpr-command-format' is used to generate the print command. +The messages are formatted by mhl. See the variable `mhl-formfile'." + (interactive (list (mh-interactive-range "Print"))) + (message "Printing...") + (let (msgs) + ;; Gather message numbers and add them to "printed" sequence. + (mh-iterate-on-range msg range + (mh-add-msgs-to-seq msg 'printed t) + (mh-notate nil mh-note-printed mh-cmd-note) + (push msg msgs)) + (setq msgs (nreverse msgs)) + ;; Print scan listing if we have more than one message. + (if (> (length msgs) 1) + (let* ((msgs-string + (mapconcat 'identity (mh-list-to-string + (mh-coalesce-msg-list msgs)) " ")) + (lpr-command + (format mh-lpr-command-format + (cond ((listp range) + (format "Folder: %s, Messages: %s" + mh-current-folder msgs-string)) + ((symbolp range) + (format "Folder: %s, Sequence: %s" + mh-current-folder range))))) + (scan-command + (format "scan %s | %s" msgs-string lpr-command))) + (if mh-print-background-flag + (mh-exec-cmd-daemon shell-file-name nil "-c" scan-command) + (call-process shell-file-name nil nil nil "-c" scan-command)))) + ;; Print the messages + (dolist (msg msgs) + (let* ((mhl-command (format "%s %s %s" + (expand-file-name "mhl" mh-lib-progs) + (if mhl-formfile + (format " -form %s" mhl-formfile) + "") + (mh-msg-filename msg))) + (lpr-command + (format mh-lpr-command-format + (format "%s/%s" mh-current-folder msg))) + (print-command + (format "%s | %s" mhl-command lpr-command))) + (if mh-print-background-flag + (mh-exec-cmd-daemon shell-file-name nil "-c" print-command) + (call-process shell-file-name nil nil nil "-c" print-command))))) + (message "Printing...done")) + +(provide 'mh-print) + +;;; Local Variables: +;;; indent-tabs-mode: nil +;;; sentence-end-double-space: nil +;;; End: + +;; arch-tag: 8d84d50b-2a49-4d0d-b51e-ba9c9b6fc679 +;;; mh-print.el ends here diff --git a/lisp/mh-e/mh-seq.el b/lisp/mh-e/mh-seq.el index 20950d36c4c..8d2369ed19a 100644 --- a/lisp/mh-e/mh-seq.el +++ b/lisp/mh-e/mh-seq.el @@ -70,7 +70,7 @@ ;;; Code: -(require 'mh-utils) +(eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-e) @@ -78,15 +78,15 @@ (defvar tool-bar-mode) ;;; Data structures (used in message threading)... -(defstruct (mh-thread-message (:conc-name mh-message-) - (:constructor mh-thread-make-message)) +(mh-defstruct (mh-thread-message (:conc-name mh-message-) + (:constructor mh-thread-make-message)) (id nil) (references ()) (subject "") (subject-re-p nil)) -(defstruct (mh-thread-container (:conc-name mh-container-) - (:constructor mh-thread-make-container)) +(mh-defstruct (mh-thread-container (:conc-name mh-container-) + (:constructor mh-thread-make-container)) message parent children (real-child-p t)) @@ -201,12 +201,15 @@ redone to get the new thread tree. This makes incremental threading easier.") ;;;###mh-autoload (defun mh-msg-is-in-seq (message) - "Display the sequences that contain MESSAGE. -Default is the displayed message." - (interactive (list (mh-get-msg-num t))) + "Display the sequences in which the current message appears. +Use a prefix argument to display the sequences in which another MESSAGE +appears." + (interactive "P") + (if (not message) + (setq message (mh-get-msg-num t))) (let* ((dest-folder (loop for seq in mh-refile-list - until (member message (cdr seq)) - finally return (car seq))) + when (member message (cdr seq)) return (car seq) + finally return nil)) (deleted-flag (unless dest-folder (member message mh-delete-list)))) (message "Message %d%s is in sequences: %s" message @@ -269,12 +272,11 @@ interactive use." (let* ((internal-seq-flag (mh-internal-seq sequence)) (original-msgs (mh-seq-msgs (mh-find-seq sequence))) (folders (list mh-current-folder)) - (msg-list ())) + (msg-list (mh-range-to-msg-list range))) + (mh-add-msgs-to-seq msg-list sequence nil t) (mh-iterate-on-range m range - (push m msg-list) (unless (memq m original-msgs) (mh-add-sequence-notation m internal-seq-flag))) - (mh-add-msgs-to-seq msg-list sequence nil t) (if (not internal-seq-flag) (setq mh-last-seq-used sequence)) (when mh-index-data @@ -292,10 +294,8 @@ OP is one of 'widen and 'unthread." ;;;###mh-autoload (defun mh-widen (&optional all-flag) - "Remove last restriction from current folder. -If optional prefix argument ALL-FLAG is non-nil, then unwind to the beginning -of the view stack thereby showing all messages that the buffer originally -contained." + "Restore the previous limit. +If optional prefix argument ALL-FLAG is non-nil, remove all limits." (interactive "P") (let ((msg (mh-get-msg-num nil))) (when mh-folder-view-stack @@ -533,28 +533,6 @@ should be replaced with: (rplaca old-seq new-name))) ;;;###mh-autoload -(defun mh-map-to-seq-msgs (func seq &rest args) - "Invoke the FUNC at each message in the SEQ. -SEQ can either be a list of messages or a MH sequence. The remaining ARGS are -passed as arguments to FUNC." - (save-excursion - (let ((msgs (if (listp seq) seq (mh-seq-to-msgs seq)))) - (while msgs - (if (mh-goto-msg (car msgs) t t) - (apply func (car msgs) args)) - (setq msgs (cdr msgs)))))) - -;;;###mh-autoload -(defun mh-notate-seq (seq notation offset) - "Mark the scan listing. -All messages in SEQ are marked with NOTATION at OFFSET from the beginning of -the line." - (let ((msg-list (mh-seq-to-msgs seq))) - (mh-iterate-on-messages-in-region msg (point-min) (point-max) - (when (member msg msg-list) - (mh-notate nil notation offset))))) - -;;;###mh-autoload (defun mh-notate-cur () "Mark the MH sequence cur. In addition to notating the current message with `mh-note-cur' the function @@ -577,14 +555,6 @@ uses `overlay-arrow-position' to put a marker in the fringe." "-sequence" (symbol-name seq) (mh-coalesce-msg-list msgs))))) -;; This has a tricky bug. mh-map-to-seq-msgs uses mh-goto-msg, which assumes -;; that the folder buffer is sorted. However in this case that assumption -;; doesn't hold. So we will do this the dumb way. -;(defun mh-copy-seq-to-point (seq location) -; ;; Copy the scan listing of the messages in SEQUENCE to after the point -; ;; LOCATION in the current buffer. -; (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location)) - (defvar mh-thread-last-ancestor) (defun mh-copy-seq-to-eob (seq) @@ -614,21 +584,6 @@ uses `overlay-arrow-position' to put a marker in the fringe." (mh-index-data (mh-index-insert-folder-headers))))))) -(defun mh-copy-line-to-point (msg location) - "Copy current message line to a specific location. -The argument MSG is not used. The message in the current line is copied to -LOCATION." - ;; msg is not used? - ;; Copy the current line to the LOCATION in the current buffer. - (beginning-of-line) - (save-excursion - (let ((beginning-of-line (point)) - end) - (forward-line 1) - (setq end (point)) - (goto-char location) - (insert-buffer-substring (current-buffer) beginning-of-line end)))) - ;;;###mh-autoload (defmacro mh-iterate-on-messages-in-region (var begin end &rest body) "Iterate over region. @@ -702,7 +657,7 @@ a region in a cons cell." (nreverse msg-list))) ;;;###mh-autoload -(defun mh-interactive-range (range-prompt) +(defun mh-interactive-range (range-prompt &optional default) "Return interactive specification for message, sequence, range or region. By convention, the name of this argument is RANGE. @@ -715,24 +670,17 @@ RANGE-PROMPT. A list of messages in that range is returned. If a MH range is given, say something like last:20, then a list containing the messages in that range is returned. +If DEFAULT non-nil then it is returned. + Otherwise, the message number at point is returned. This function is usually used with `mh-iterate-on-range' in order to provide a uniform interface to MH-E functions." (cond ((mh-mark-active-p t) (cons (region-beginning) (region-end))) (current-prefix-arg (mh-read-range range-prompt nil nil t t)) + (default default) (t (mh-get-msg-num t)))) -;;;###mh-autoload -(defun mh-region-to-msg-list (begin end) - "Return a list of messages within the region between BEGIN and END." - ;; If end is end of buffer back up one position - (setq end (if (equal end (point-max)) (1- end) end)) - (let ((result)) - (mh-iterate-on-messages-in-region index begin end - (when (numberp index) (push index result))) - result)) - ;;; Commands to handle new 'subject sequence. @@ -772,7 +720,7 @@ Return number of messages put in the sequence: (if (or (not (looking-at mh-scan-subject-regexp)) (not (match-string 3)) (string-equal "" (match-string 3))) - (progn (message "No subject line.") + (progn (message "No subject line") nil) (let ((subject (match-string-no-properties 3)) (list)) @@ -835,61 +783,57 @@ This function can only be used the folder is threaded." (mh-container-message (gethash (gethash msg mh-thread-index-id-map) mh-thread-id-table))))) -;;;###mh-autoload -(defun mh-narrow-to-subject () - "Narrow to a sequence containing all following messages with same subject." - (interactive) - (let ((num (mh-get-msg-num nil)) - (count (mh-subject-to-sequence t))) - (cond - ((not count) ; No subject line, delete msg anyway - nil) - ((= 0 count) ; No other msgs, delete msg anyway. - (message "No other messages with same Subject following this one.") - nil) - (t ; We have a subject sequence. - (message "Found %d messages for subject sequence." count) - (mh-narrow-to-seq 'subject) - (if (numberp num) - (mh-goto-msg num t t)))))) - -(defun mh-read-pick-regexp (default) - "With prefix arg read a pick regexp. +(defun mh-edit-pick-expr (default) + "With prefix arg edit a pick expression. If no prefix arg is given, then return DEFAULT." (let ((default-string (loop for x in default concat (format " %s" x)))) (if (or current-prefix-arg (equal default-string "")) - (delete "" (split-string (read-string "Pick regexp: " default-string))) + (delete "" (split-string (read-string "Pick expression: " + default-string))) default))) ;;;###mh-autoload -(defun mh-narrow-to-from (&optional regexp) - "Limit to messages with the same From header field as the message at point. -With a prefix argument, prompt for the regular expression, REGEXP given to -pick." +(defun mh-narrow-to-subject (&optional pick-expr) + "Limit to messages with same subject. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (interactive - (list (mh-read-pick-regexp (mh-current-message-header-field 'from)))) - (mh-narrow-to-header-field 'from regexp)) + (list (mh-edit-pick-expr (mh-current-message-header-field 'subject)))) + (mh-narrow-to-header-field 'subject pick-expr)) ;;;###mh-autoload -(defun mh-narrow-to-cc (&optional regexp) - "Limit to messages with the same Cc header field as the message at point. -With a prefix argument, prompt for the regular expression, REGEXP given to -pick." +(defun mh-narrow-to-from (&optional pick-expr) + "Limit to messages with the same `From:' field. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (interactive - (list (mh-read-pick-regexp (mh-current-message-header-field 'cc)))) - (mh-narrow-to-header-field 'cc regexp)) + (list (mh-edit-pick-expr (mh-current-message-header-field 'from)))) + (mh-narrow-to-header-field 'from pick-expr)) ;;;###mh-autoload -(defun mh-narrow-to-to (&optional regexp) - "Limit to messages with the same To header field as the message at point. -With a prefix argument, prompt for the regular expression, REGEXP given to -pick." +(defun mh-narrow-to-cc (&optional pick-expr) + "Limit to messages with the same `Cc:' field. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (interactive - (list (mh-read-pick-regexp (mh-current-message-header-field 'to)))) - (mh-narrow-to-header-field 'to regexp)) + (list (mh-edit-pick-expr (mh-current-message-header-field 'cc)))) + (mh-narrow-to-header-field 'cc pick-expr)) -(defun mh-narrow-to-header-field (header-field regexp) - "Limit to messages whose HEADER-FIELD match REGEXP. +;;;###mh-autoload +(defun mh-narrow-to-to (&optional pick-expr) + "Limit to messages with the same `To:' field. +With a prefix argument, edit PICK-EXPR. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." + (interactive + (list (mh-edit-pick-expr (mh-current-message-header-field 'to)))) + (mh-narrow-to-header-field 'to pick-expr)) + +(defun mh-narrow-to-header-field (header-field pick-expr) + "Limit to messages whose HEADER-FIELD match PICK-EXPR. The MH command pick is used to do the match." (let ((folder mh-current-folder) (original (mh-coalesce-msg-list @@ -897,7 +841,7 @@ The MH command pick is used to do the match." (msg-list ())) (with-temp-buffer (apply #'mh-exec-cmd-output "pick" nil folder - (append original (list "-list") regexp)) + (append original (list "-list") pick-expr)) (goto-char (point-min)) (while (not (eobp)) (let ((num (read-from-string @@ -939,7 +883,9 @@ The MH command pick is used to do the match." "Limit to messages in RANGE. Check the documentation of `mh-interactive-range' to see how RANGE is read in -interactive use." +interactive use. + +Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (interactive (list (mh-interactive-range "Narrow to"))) (when (assoc 'range mh-seq-list) (mh-delete-seq 'range)) (mh-add-msgs-to-seq (mh-range-to-msg-list range) 'range) @@ -958,7 +904,7 @@ subject sequence." ((not count) ; No subject line, delete msg anyway (mh-delete-msg (mh-get-msg-num t))) ((= 0 count) ; No other msgs, delete msg anyway. - (message "No other messages with same Subject following this one.") + (message "No other messages with same Subject following this one") (mh-delete-msg (mh-get-msg-num t))) (t ; We have a subject sequence. (message "Marked %d messages for deletion" count) @@ -1078,13 +1024,12 @@ SUBJECT and REFS fields." message) (container (setf (mh-container-message container) - (mh-thread-make-message :subject subject - :subject-re-p subject-re-p - :id id :references refs))) - (t (let ((message (mh-thread-make-message - :subject subject - :subject-re-p subject-re-p - :id id :references refs))) + (mh-thread-make-message :id id :references refs + :subject subject + :subject-re-p subject-re-p))) + (t (let ((message (mh-thread-make-message :id id :references refs + :subject-re-p subject-re-p + :subject subject))) (prog1 message (mh-thread-get-message-container message))))))) @@ -1450,8 +1395,7 @@ MSG is the message being notated with NOTATION at OFFSET." (cur-scan-line (and mh-thread-scan-line-map (gethash msg mh-thread-scan-line-map))) (old-scan-lines (loop for map in mh-thread-scan-line-map-stack - collect (and map (gethash msg map)))) - (notation (if (stringp notation) (aref notation 0) notation))) + collect (and map (gethash msg map))))) (when cur-scan-line (setf (aref (car cur-scan-line) offset) notation)) (dolist (line old-scan-lines) @@ -1486,7 +1430,8 @@ MSG is the message being notated with NOTATION at OFFSET." (setf (gethash msg mh-thread-scan-line-map) v)))) (when (> (hash-table-count mh-thread-scan-line-map) 0) (insert (if (bobp) "" "\n") (car x) "\n") - (mh-thread-generate-scan-lines thread-tree -2))))))) + (mh-thread-generate-scan-lines thread-tree -2)))) + (mh-index-create-imenu-index)))) (defun mh-thread-folder () "Generate thread view of folder." @@ -1711,11 +1656,12 @@ start of the region and the second is the point at the end." (push msg unticked) (setcdr tick-seq (delq msg (cdr tick-seq))) (when (null (cdr tick-seq)) (setq mh-last-seq-used nil)) - (mh-remove-sequence-notation msg t)) + (mh-remove-sequence-notation msg (mh-colors-in-use-p))) (t (push msg ticked) (setq mh-last-seq-used mh-tick-seq) - (mh-add-sequence-notation msg t)))) + (let ((mh-seq-list (cons `(,mh-tick-seq ,msg) mh-seq-list))) + (mh-add-sequence-notation msg (mh-colors-in-use-p)))))) (mh-add-msgs-to-seq ticked mh-tick-seq nil t) (mh-undefine-sequence mh-tick-seq unticked) (when mh-index-data @@ -1724,16 +1670,16 @@ start of the region and the second is the point at the end." ;;;###mh-autoload (defun mh-narrow-to-tick () - "Restrict display of this folder to just messages in `mh-tick-seq'. + "Limit to messages in `mh-tick-seq'. + Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." (interactive) (cond ((not mh-tick-seq) (error "Enable ticking by customizing `mh-tick-seq'")) ((null (mh-seq-msgs (mh-find-seq mh-tick-seq))) - (message "No messages in tick sequence")) + (message "No messages in %s sequence" mh-tick-seq)) (t (mh-narrow-to-seq mh-tick-seq)))) - (provide 'mh-seq) ;;; Local Variables: diff --git a/lisp/mh-e/mh-speed.el b/lisp/mh-e/mh-speed.el index 967984d1104..2617a941de1 100644 --- a/lisp/mh-e/mh-speed.el +++ b/lisp/mh-e/mh-speed.el @@ -34,10 +34,11 @@ ;;; Code: ;; Requires -(require 'mh-utils) +(eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'mh-e) (require 'speedbar) +(require 'timer) ;; Global variables (defvar mh-speed-refresh-flag nil) @@ -90,26 +91,25 @@ BUFFER is the MH-E buffer for which the speedbar buffer is to be created." "+" mh-speed-expand-folder "-" mh-speed-contract-folder "\r" mh-speed-view - "f" mh-speed-flists - "i" mh-speed-invalidate-map) + "r" mh-speed-refresh) (defvar mh-show-speedbar-key-map mh-folder-speedbar-key-map) (defvar mh-letter-speedbar-key-map mh-folder-speedbar-key-map) ;; Menus for speedbar... (defvar mh-folder-speedbar-menu-items - '(["Visit Folder" mh-speed-view + '("--" + ["Visit Folder" mh-speed-view (save-excursion (set-buffer speedbar-buffer) (get-text-property (line-beginning-position) 'mh-folder))] - ["Expand nested folders" mh-speed-expand-folder + ["Expand Nested Folders" mh-speed-expand-folder (and (get-text-property (line-beginning-position) 'mh-children-p) (not (get-text-property (line-beginning-position) 'mh-expanded)))] - ["Contract nested folders" mh-speed-contract-folder + ["Contract Nested Folders" mh-speed-contract-folder (and (get-text-property (line-beginning-position) 'mh-children-p) (get-text-property (line-beginning-position) 'mh-expanded))] - ["Run Flists" mh-speed-flists t] - ["Invalidate cached folders" mh-speed-invalidate-map t]) + ["Refresh Speedbar" mh-speed-refresh t]) "Extra menu items for speedbar.") (defvar mh-show-speedbar-menu-items mh-folder-speedbar-menu-items) @@ -352,6 +352,14 @@ Optional ARGS are ignored." (defvar mh-speed-current-folder nil) (defvar mh-speed-flists-folder nil) +(defmacro mh-process-kill-without-query (process) + "PROCESS can be killed without query on Emacs exit. +Avoid using `process-kill-without-query' if possible since it is now +obsolete." + (if (fboundp 'set-process-query-on-exit-flag) + `(set-process-query-on-exit-flag ,process nil) + `(process-kill-without-query ,process))) + ;;;###mh-autoload (defun mh-speed-flists (force &rest folders) "Execute flists -recurse and update message counts. @@ -396,6 +404,7 @@ only for that one folder." (or mh-speed-flists-folder '("-recurse")))) ;; Run flists on all folders the next time around... (setq mh-speed-flists-folder nil) + (mh-process-kill-without-query mh-speed-flists-process) (set-process-filter mh-speed-flists-process 'mh-speed-parse-flists-output))))))) @@ -494,6 +503,14 @@ next." (when (equal folder "") (clrhash mh-sub-folders-cache))))) +(defun mh-speed-refresh () + "Refresh the speedbar. +Use this function to refresh the speedbar if folders have been added or +deleted or message ranges have been updated outside of MH-E." + (interactive) + (mh-speed-flists t) + (mh-speed-invalidate-map "")) + ;;;###mh-autoload (defun mh-speed-add-folder (folder) "Add FOLDER since it is being created. diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el index b1966915e86..a57567a7bd3 100644 --- a/lisp/mh-e/mh-utils.el +++ b/lisp/mh-e/mh-utils.el @@ -33,20 +33,14 @@ ;;; Code: -;; Is this XEmacs-land? Located here since needed by mh-customize.el. -(defvar mh-xemacs-flag (featurep 'xemacs) - "Non-nil means the current Emacs is XEmacs.") - -;; The Emacs coding conventions require that the cl package not be required at -;; runtime. However, the cl package in versions of Emacs prior to 21.4 left cl -;; routines in their macro expansions. Use mh-require-cl to provide the cl -;; routines in the best way possible. -(eval-when-compile (require 'cl)) -(defmacro mh-require-cl () - (if (eq (car (macroexpand '(setf (gethash foo bar) baz))) 'cl-puthash) - `(require 'cl) - `(eval-when-compile (require 'cl)))) +(defvar recursive-load-depth-limit) +(eval-and-compile + (if (and (boundp 'recursive-load-depth-limit) + (integerp recursive-load-depth-limit) + (> 50 recursive-load-depth-limit)) + (setq recursive-load-depth-limit 50))) +(eval-when-compile (require 'mh-acros)) (mh-require-cl) (require 'gnus-util) (require 'font-lock) @@ -58,6 +52,7 @@ (load "mm-decode" t t) ; Non-fatal dependency (load "mm-view" t t) ; Non-fatal dependency +(load "vcard" t t) ; Non-fatal dependency (load "hl-line" t t) ; Non-fatal dependency (load "executable" t t) ; Non-fatal dependency on ; executable-find @@ -69,43 +64,12 @@ ;;; Autoloads (autoload 'gnus-article-highlight-citation "gnus-cite") +(autoload 'message-fetch-field "message") +(autoload 'message-tokenize-header "message") (require 'sendmail) -(autoload 'Info-goto-node "info") (unless (fboundp 'make-hash-table) (autoload 'make-hash-table "cl")) -;;; Set for local environment: -;;; mh-progs and mh-lib used to be set in paths.el, which tried to -;;; figure out at build time which of several possible directories MH -;;; was installed into. But if you installed MH after building Emacs, -;;; this would almost certainly be wrong, so now we do it at run time. - -(defvar mh-progs nil - "Directory containing MH commands, such as inc, repl, and rmm.") - -(defvar mh-lib nil - "Directory containing the MH library. -This directory contains, among other things, the components file.") - -(defvar mh-lib-progs nil - "Directory containing MH helper programs. -This directory contains, among other things, the mhl program.") - -(defvar mh-nmh-flag nil - "Non-nil means nmh is installed on this system instead of MH.") - -(defvar mh-flists-present-flag nil - "Non-nil means that we have `flists'.") - -;;;###autoload -(put 'mh-progs 'risky-local-variable t) -;;;###autoload -(put 'mh-lib 'risky-local-variable t) -;;;###autoload -(put 'mh-lib-progs 'risky-local-variable t) -;;;###autoload -(put 'mh-nmh-flag 'risky-local-variable t) - ;;; CL Replacements (defun mh-search-from-end (char string) "Return the position of last occurrence of CHAR in STRING. @@ -115,92 +79,52 @@ of `search' in the CL package." when (equal (aref string index) char) return index finally return nil)) -;;; Macros to generate correct code for different emacs variants - -(defmacro mh-do-in-gnu-emacs (&rest body) - "Execute BODY if in GNU Emacs." - (unless mh-xemacs-flag `(progn ,@body))) -(put 'mh-do-in-gnu-emacs 'lisp-indent-hook 'defun) - -(defmacro mh-do-in-xemacs (&rest body) - "Execute BODY if in GNU Emacs." - (when mh-xemacs-flag `(progn ,@body))) -(put 'mh-do-in-xemacs 'lisp-indent-hook 'defun) - -(defmacro mh-funcall-if-exists (function &rest args) - "Call FUNCTION with ARGS as parameters if it exists." - (if (fboundp function) - `(funcall ',function ,@args))) - -(defmacro mh-make-local-hook (hook) - "Make HOOK local if needed. -XEmacs and versions of GNU Emacs before 21.1 require `make-local-hook' to be -called." - (when (and (fboundp 'make-local-hook) - (not (get 'make-local-hook 'byte-obsolete-info))) - `(make-local-hook ,hook))) - -(defmacro mh-mark-active-p (check-transient-mark-mode-flag) - "A macro that expands into appropriate code in XEmacs and nil in GNU Emacs. -In GNU Emacs if CHECK-TRANSIENT-MARK-MODE-FLAG is non-nil then check if -variable `transient-mark-mode' is active." - (cond (mh-xemacs-flag ;XEmacs - `(and (boundp 'zmacs-regions) zmacs-regions (region-active-p))) - ((not check-transient-mark-mode-flag) ;GNU Emacs - `(and (boundp 'mark-active) mark-active)) - (t ;GNU Emacs - `(and (boundp 'transient-mark-mode) transient-mark-mode - (boundp 'mark-active) mark-active)))) - ;;; Additional header fields that might someday be added: ;;; "Sender: " "Reply-to: " + +;;; Scan Line Formats + (defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)" - "Regexp to find the number of a message in a scan line. -The message's number must be surrounded with \\( \\)") + "This regexp is used to extract the message number from a scan line. +Note that the message number must be placed in a parenthesized expression as +in the default of \"^ *\\\\([0-9]+\\\\)\".") (defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]" - "Regexp to find a scan line in which the message number overflowed. -The message's number is left truncated in this case.") + "This regexp matches scan lines in which the message number overflowed.") (defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)" - "Regexp to find message number width in an scan format. -The message number width must be surrounded with \\( \\).") + "This regexp is used to find the message number width in a scan format. +Note that the message number must be placed in a parenthesized expression as +in the default of \"%\\\\([0-9]*\\\\)(msg)\".") (defvar mh-scan-msg-format-string "%d" - "Format string for width of the message number in a scan format. + "This is a format string for width of the message number in a scan format. Use `0%d' for zero-filled message numbers.") (defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]" - "Format string containing a regexp matching the scan listing for a message. -The desired message's number will be an argument to format.") - -(defvar mh-default-folder-for-message-function nil - "Function to select a default folder for refiling or Fcc. -If set to a function, that function is called with no arguments by -`\\[mh-refile-msg]' and `\\[mh-to-fcc]' to get a default when -prompting the user for a folder. The function is called from within a -`save-excursion', with point at the start of the message. It should -return the folder to offer as the refile or Fcc folder, as a string -with a leading `+' sign. It can also return an empty string to use no -default, or nil to calculate the default the usual way. -NOTE: This variable is not an ordinary hook; -It may not be a list of functions.") + "This format string regexp matches the scan line for a particular message. +Use `%d' to represent the location of the message number within the +expression as in the default of \"^[^0-9]*%d[^0-9]\".") + +(defvar mh-cmd-note 4 + "This is the number of characters to skip over before inserting notation. +This variable should be set with the function `mh-set-cmd-note'. This variable +may be updated dynamically if `mh-adaptive-cmd-note-flag' is non-nil and +`mh-scan-format-file' is t.") +(make-variable-buffer-local 'mh-cmd-note) + +(defvar mh-note-seq ?% + "Messages in a user-defined sequence are marked by this character. +Messages in the `search' sequence are marked by this character as well.") + + (defvar mh-show-buffer-mode-line-buffer-id " {show-%s} %d" "Format string to produce `mode-line-buffer-identification' for show buffers. First argument is folder name. Second is message number.") -(defvar mh-cmd-note 4 - "Column to insert notation. -Use `mh-set-cmd-note' to modify it. -This value may be dynamically updated if `mh-adaptive-cmd-note-flag' is -non-nil and `mh-scan-format-file' is t. -Note that the first column is column number 0.") -(make-variable-buffer-local 'mh-cmd-note) - -(defvar mh-note-seq "%" - "String whose first character is used to notate messages in a sequence.") + (defvar mh-mail-header-separator "--------" "*Line used by MH to separate headers from text in messages being composed. @@ -213,11 +137,29 @@ Do not make this a regexp as it may be the argument to `insert' and it is passed through `regexp-quote' before being used by functions like `re-search-forward'.") +(defvar mh-signature-separator-regexp "^-- $" + "Regexp used to find signature separator. +See `mh-signature-separator'.") + +(defvar mh-signature-separator "-- \n" + "Text of a signature separator. +A signature separator is used to separate the body of a message from the +signature. This can be used by user agents such as MH-E to render the +signature differently or to suppress the inclusion of the signature in a +reply. +Use `mh-signature-separator-regexp' when searching for a separator.") + +(defun mh-signature-separator-p () + "Return non-nil if buffer includes \"^-- $\"." + (save-excursion + (goto-char (point-min)) + (re-search-forward mh-signature-separator-regexp nil t))) + ;; Variables for MIME display ;; Structure to keep track of MIME handles on a per buffer basis. -(defstruct (mh-buffer-data (:conc-name mh-mime-) - (:constructor mh-make-buffer-data)) +(mh-defstruct (mh-buffer-data (:conc-name mh-mime-) + (:constructor mh-make-buffer-data)) (handles ()) ; List of MIME handles (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of ; nested messages @@ -331,7 +273,7 @@ passed through `regexp-quote' before being used by functions like "A regular expression probably matching an e-mail address.") ;; From goto-addr.el, which we don't want to force-load on users. -;;;###mh-autoload + (defun mh-goto-address-find-address-at-point () "Find e-mail address around or before point. Then search backwards to beginning of line for the start of an e-mail @@ -348,7 +290,18 @@ address. If no e-mail address found, return nil." In MH-E we frequently need to find the end of headers in nested messages, where the buffer has been narrowed. This function works in this situation." (save-excursion - (rfc822-goto-eoh) + ;; XXX: The following replaces a call to rfc822-goto-eoh. Occasionally, + ;; mail headers that MH-E has to read contains lines of the form: + ;; From xxx@yyy Mon May 10 11:48:07 2004 + ;; In this situation, rfc822-goto-eoh doesn't go to the end of the + ;; header. The replacement allows From_ lines in the mail header. + (goto-char (point-min)) + (loop for p = (re-search-forward + "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move) + do (cond ((null p) (return)) + (t (goto-char (match-beginning 0)) + (unless (looking-at "From ") (return)) + (goto-char p)))) (point))) (defun mh-in-header-p () @@ -528,17 +481,20 @@ message about the fontification operation." ;; hidden and can be programmatically removed in mh-quit), and the variable ;; names have the form mh-temp-.*-buffer. (defconst mh-temp-buffer " *mh-temp*") ;scratch +(defconst mh-temp-fetch-buffer " *mh-fetch*") ;wget/curl/fetch output ;; The names of MH-E buffers that are not ephemeral and can be used by the ;; user (and deleted by the user when no longer needed) have a "*MH-E " prefix ;; (so they can be programmatically removed in mh-quit), and the variable ;; names have the form mh-.*-buffer. +(defconst mh-aliases-buffer "*MH-E Aliases*") ;alias lookups (defconst mh-folders-buffer "*MH-E Folders*") ;folder list +(defconst mh-help-buffer "*MH-E Help*") ;quick help (defconst mh-info-buffer "*MH-E Info*") ;version information buffer (defconst mh-log-buffer "*MH-E Log*") ;output of MH commands and so on +(defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log (defconst mh-recipients-buffer "*MH-E Recipients*") ;killed when draft sent (defconst mh-sequences-buffer "*MH-E Sequences*") ;sequences list -(defconst mh-mail-delivery-buffer "*MH-E Mail Delivery*") ;mail delivery log ;; Number of lines to keep in mh-log-buffer. (defvar mh-log-buffer-lines 100) @@ -593,7 +549,6 @@ message about the fontification operation." (cons modeline-buffer-id-left-extent "XEmacs%N:")) (cons modeline-buffer-id-right-extent " %17b"))))) - ;;; This holds a documentation string used by describe-mode. (defun mh-showing-mode (&optional arg) "Change whether messages should be displayed. @@ -614,7 +569,6 @@ With arg, display messages iff ARG is positive." ;; Showing message with headers or normally. (defvar mh-showing-with-headers nil) - ;;; MH-E macros (defmacro with-mh-folder-updating (save-modification-flag &rest body) @@ -742,7 +696,7 @@ of the buffer in the event window is preserved." (unlock-buffer) (setq buffer-file-name nil)) -;;;###mh-autoload + (defun mh-get-msg-num (error-if-no-message) "Return the message number of the displayed message. If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is @@ -915,6 +869,16 @@ still visible.\n") (mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages) (mh-defun-show-buffer mh-show-index-sequenced-messages mh-index-sequenced-messages) +(mh-defun-show-buffer mh-show-catchup mh-catchup) +(mh-defun-show-buffer mh-show-ps-print-toggle-mime mh-ps-print-toggle-mime) +(mh-defun-show-buffer mh-show-ps-print-toggle-color mh-ps-print-toggle-color) +(mh-defun-show-buffer mh-show-ps-print-toggle-faces mh-ps-print-toggle-faces) +(mh-defun-show-buffer mh-show-ps-print-msg-file mh-ps-print-msg-file) +(mh-defun-show-buffer mh-show-ps-print-msg mh-ps-print-msg) +(mh-defun-show-buffer mh-show-ps-print-msg-show mh-ps-print-msg-show) +(mh-defun-show-buffer mh-show-toggle-mime-buttons mh-toggle-mime-buttons) +(mh-defun-show-buffer mh-show-display-with-external-viewer + mh-display-with-external-viewer) ;;; Populate mh-show-mode-map (gnus-define-keys mh-show-mode-map @@ -941,7 +905,6 @@ still visible.\n") "g" mh-show-goto-msg "i" mh-show-inc-folder "k" mh-show-delete-subject-or-thread - "l" mh-show-print-msg "m" mh-show-send "n" mh-show-next-undeleted-msg "\M-n" mh-show-next-unread-msg @@ -961,6 +924,7 @@ still visible.\n") "?" mh-prefix-help "'" mh-index-ticked-messages "S" mh-show-sort-folder + "c" mh-show-catchup "f" mh-show-visit-folder "i" mh-index-search "k" mh-show-kill-folder @@ -992,6 +956,17 @@ still visible.\n") "b" mh-show-junk-blacklist "w" mh-show-junk-whitelist) +(gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map) + "?" mh-prefix-help + "A" mh-show-ps-print-toggle-mime + "C" mh-show-ps-print-toggle-color + "F" mh-show-ps-print-toggle-faces + "M" mh-show-ps-print-toggle-mime + "f" mh-show-ps-print-msg-file + "l" mh-show-print-msg + "p" mh-show-ps-print-msg + "s" mh-show-ps-print-msg-show) + (gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) "?" mh-prefix-help "u" mh-show-thread-ancestor @@ -1026,9 +1001,11 @@ still visible.\n") (gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map) "?" mh-prefix-help "a" mh-mime-save-parts + "e" mh-show-display-with-external-viewer "v" mh-show-toggle-mime-part "o" mh-show-save-mime-part "i" mh-show-inline-mime-part + "t" mh-show-toggle-mime-buttons "\t" mh-show-next-button [backtab] mh-show-prev-button "\M-\t" mh-show-prev-button) @@ -1115,7 +1092,10 @@ still visible.\n") (define-derived-mode mh-show-mode text-mode "MH-Show" "Major mode for showing messages in MH-E.\\<mh-show-mode-map> The value of `mh-show-mode-hook' is a list of functions to -be called, with no arguments, upon entry to this mode." +be called, with no arguments, upon entry to this mode. +See also `mh-folder-mode'. + +\\{mh-show-mode-map}" (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) (setq paragraph-start (default-value 'paragraph-start)) (mh-show-unquote-From) @@ -1210,8 +1190,9 @@ be called, with no arguments, upon entry to this mode." (mh-do-in-xemacs (defvar default-enable-multibyte-characters)) (defun mh-face-display-function () - "Display a Face or X-Face header field. -Display Face if both are present." + "Display a Face, X-Face, or X-Image-URL header field. +If more than one of these are present, then the first one found in this order +is used." (save-restriction (goto-char (point-min)) (re-search-forward "\n\n" (point-max) t) @@ -1226,7 +1207,8 @@ Display Face if both are present." type 'png)) (x-face (setq raw (mh-uncompface x-face) type 'pbm)) - (url (setq type 'url))) + (url (setq type 'url)) + (t (multiple-value-setq (type raw) (mh-picon-get-image)))) (when type (goto-char (point-min)) (when (re-search-forward "^from:" (point-max) t) @@ -1261,10 +1243,15 @@ Display Face if both are present." ((and (eq type 'pbm) (fboundp 'x-face-xmas-wl-display-x-face) (fboundp 'executable-find) (executable-find "uncompface")) - (mh-funcall-if-exists x-face-xmas-wl-display-x-face))) + (mh-funcall-if-exists x-face-xmas-wl-display-x-face)) + ;; Picon display + ((and raw (member type '(xpm xbm gif))) + (when (featurep type) + (set-extent-begin-glyph + (make-extent (point) (point)) + (make-glyph (vector type ':data raw)))))) (when raw (insert " ")))))))) - (defun mh-show-xface () "Display X-Face." (when (and window-system mh-show-use-xface-flag @@ -1274,49 +1261,207 @@ Display Face if both are present." +;; Picon display + +;;; XXX: This should be customizable. As a side-effect of setting this +;;; variable, arrange to reset mh-picon-existing-directory-list to 'unset. +(defvar mh-picon-directory-list + '("~/.picons" "~/.picons/users" "~/.picons/usenix" "~/.picons/news" + "~/.picons/domains" "~/.picons/misc" + "/usr/share/picons/" "/usr/share/picons/users" "/usr/share/picons/usenix" + "/usr/share/picons/news" "/usr/share/picons/domains" + "/usr/share/picons/misc") + "List of directories where picons reside. +The directories are searched for in the order they appear in the list.") + +(defvar mh-picon-existing-directory-list 'unset + "List of directories to search in.") + +(defvar mh-picon-cache (make-hash-table :test #'equal)) + +(defvar mh-picon-image-types + (loop for type in '(xpm xbm gif) + when (or (mh-do-in-gnu-emacs + (ignore-errors + (mh-funcall-if-exists image-type-available-p type))) + (mh-do-in-xemacs (featurep type))) + collect type)) + +(defun mh-picon-set-directory-list () + "Update `mh-picon-existing-directory-list' if needed." + (when (eq mh-picon-existing-directory-list 'unset) + (setq mh-picon-existing-directory-list + (loop for x in mh-picon-directory-list + when (file-directory-p x) collect x)))) + +(defun* mh-picon-get-image () + "Find the best possible match and return contents." + (mh-picon-set-directory-list) + (save-restriction + (let* ((from-field (ignore-errors (car (message-tokenize-header + (mh-get-header-field "from:"))))) + (from (car (ignore-errors + (mh-funcall-if-exists ietf-drums-parse-address + from-field)))) + (host (and from + (string-match "\\([^+]*\\)\\(+.*\\)?@\\(.*\\)" from) + (downcase (match-string 3 from)))) + (user (and host (downcase (match-string 1 from)))) + (canonical-address (format "%s@%s" user host)) + (cached-value (gethash canonical-address mh-picon-cache)) + (host-list (and host (delete "" (split-string host "\\.")))) + (match nil)) + (cond (cached-value (return-from mh-picon-get-image cached-value)) + ((not host-list) (return-from mh-picon-get-image nil))) + (setq match + (block 'loop + ;; u@h search + (loop for dir in mh-picon-existing-directory-list + do (loop for type in mh-picon-image-types + ;; [path]user@host + for file1 = (format "%s/%s.%s" + dir canonical-address type) + when (file-exists-p file1) + do (return-from 'loop file1) + ;; [path]user + for file2 = (format "%s/%s.%s" dir user type) + when (file-exists-p file2) + do (return-from 'loop file2) + ;; [path]host + for file3 = (format "%s/%s.%s" dir host type) + when (file-exists-p file3) + do (return-from 'loop file3))) + ;; facedb search + ;; Search order for user@foo.net: + ;; [path]net/foo/user + ;; [path]net/foo/user/face + ;; [path]net/user + ;; [path]net/user/face + ;; [path]net/foo/unknown + ;; [path]net/foo/unknown/face + ;; [path]net/unknown + ;; [path]net/unknown/face + (loop for u in (list user "unknown") + do (loop for dir in mh-picon-existing-directory-list + do (loop for x on host-list by #'cdr + for y = (mh-picon-generate-path x u dir) + do (loop for type in mh-picon-image-types + for z1 = (format "%s.%s" y type) + when (file-exists-p z1) + do (return-from 'loop z1) + for z2 = (format "%s/face.%s" + y type) + when (file-exists-p z2) + do (return-from 'loop z2))))))) + (setf (gethash canonical-address mh-picon-cache) + (mh-picon-file-contents match))))) + +(defun mh-picon-file-contents (file) + "Return details about FILE. +A list of consisting of a symbol for the type of the file and the file +contents as a string is returned. If FILE is nil, then both elements of the +list are nil." + (if (stringp file) + (with-temp-buffer + (let ((type (and (string-match ".*\\.\\(...\\)$" file) + (intern (match-string 1 file))))) + (insert-file-contents-literally file) + (values type (buffer-string)))) + (values nil nil))) + +(defun mh-picon-generate-path (host-list user directory) + "Generate the image file path. +HOST-LIST is the parsed host address of the email address, USER the username +and DIRECTORY is the directory relative to which the path is generated." + (loop with acc = "" + for elem in host-list + do (setq acc (format "%s/%s" elem acc)) + finally return (format "%s/%s%s" directory acc user))) + + + ;; X-Image-URL display (defvar mh-x-image-cache-directory nil "Directory where X-Image-URL images are cached.") - -(defvar mh-convert-executable (executable-find "convert")) -(defvar mh-wget-executable (executable-find "wget")) +(defvar mh-x-image-scaling-function + (cond ((executable-find "convert") + 'mh-x-image-scale-with-convert) + ((and (executable-find "anytopnm") (executable-find "pnmscale") + (executable-find "pnmtopng")) + 'mh-x-image-scale-with-pnm) + (t 'ignore)) + "Function to use to scale image to proper size.") +(defvar mh-wget-executable nil) +(defvar mh-wget-choice + (or (and (setq mh-wget-executable (executable-find "wget")) 'wget) + (and (setq mh-wget-executable (executable-find "fetch")) 'fetch) + (and (setq mh-wget-executable (executable-find "curl")) 'curl))) +(defvar mh-wget-option + (cdr (assoc mh-wget-choice '((curl . "-o") (fetch . "-o") (wget . "-O"))))) (defvar mh-x-image-temp-file nil) (defvar mh-x-image-url nil) (defvar mh-x-image-marker nil) (defvar mh-x-image-url-cache-file nil) +;; Functions to scale image to proper size +(defun mh-x-image-scale-with-pnm (input output) + "Scale image in INPUT file and write to OUTPUT file using pnm tools." + (let ((res (shell-command-to-string + (format "anytopnm < %s | pnmscale -xysize 96 48 | pnmtopng > %s" + input output)))) + (unless (equal res "") + (delete-file output)))) + +(defun mh-x-image-scale-with-convert (input output) + "Scale image in INPUT file and write to OUTPUT file using ImageMagick." + (call-process "convert" nil nil nil "-geometry" "96x48" input output)) + (defun mh-x-image-url-cache-canonicalize (url) "Canonicalize URL. -Replace the ?/ character with a ?! character." - (with-temp-buffer - (insert url) - (goto-char (point-min)) - (while (search-forward "/" nil t) (replace-match "!")) - (format "%s/%s.png" mh-x-image-cache-directory (buffer-string)))) +Replace the ?/ character with a ?! character and append .png." + (format "%s/%s.png" mh-x-image-cache-directory + (with-temp-buffer + (insert url) + (mh-replace-string "/" "!") + (buffer-string)))) + +(defun mh-x-image-set-download-state (file data) + "Setup a symbolic link from FILE to DATA." + (if data + (make-symbolic-link (symbol-name data) file t) + (delete-file file))) + +(defun mh-x-image-get-download-state (file) + "Check the state of FILE by following any symbolic links." + (unless (file-exists-p mh-x-image-cache-directory) + (call-process "mkdir" nil nil nil mh-x-image-cache-directory)) + (cond ((file-symlink-p file) + (intern (file-name-nondirectory (file-chase-links file)))) + ((not (file-exists-p file)) nil) + (t 'ok))) (defun mh-x-image-url-fetch-image (url cache-file marker sentinel) "Fetch and display the image specified by URL. After the image is fetched, it is stored in CACHE-FILE. It will be displayed in a buffer and position specified by MARKER. The actual display is carried out by the SENTINEL function." - (if (and mh-wget-executable - mh-fetch-x-image-url - (or (eq mh-fetch-x-image-url t) - (y-or-n-p (format "Fetch %s? " url)))) - (let ((buffer (get-buffer-create (generate-new-buffer-name " *mh-url*"))) - (filename (make-temp-name "/tmp/mhe-wget"))) + (if mh-wget-executable + (let ((buffer (get-buffer-create (generate-new-buffer-name + mh-temp-fetch-buffer))) + (filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch") + (expand-file-name (make-temp-name "~/mhe-fetch"))))) (save-excursion (set-buffer buffer) (set (make-local-variable 'mh-x-image-url-cache-file) cache-file) (set (make-local-variable 'mh-x-image-marker) marker) (set (make-local-variable 'mh-x-image-temp-file) filename)) (set-process-sentinel - (start-process "*wget*" buffer mh-wget-executable "-O" filename url) + (start-process "*mh-x-image-url-fetch*" buffer + mh-wget-executable mh-wget-option filename url) sentinel)) - ;; Make sure we don't ask about this image again - (when (and mh-wget-executable (eq mh-fetch-x-image-url 'ask)) - (make-symbolic-link mh-x-image-cache-directory cache-file t)))) + ;; Temporary failure + (mh-x-image-set-download-state cache-file 'try-again))) (defun mh-x-image-display (image marker) "Display IMAGE at MARKER." @@ -1326,7 +1471,8 @@ out by the SENTINEL function." (default-enable-multibyte-characters nil) (buffer-modified-flag (buffer-modified-p))) (unwind-protect - (when (and (file-readable-p image) (not (file-symlink-p image))) + (when (and (file-readable-p image) (not (file-symlink-p image)) + (eq marker mh-x-image-marker)) (goto-char marker) (mh-do-in-gnu-emacs (mh-funcall-if-exists insert-image (create-image image 'png))) @@ -1350,32 +1496,56 @@ The argument CHANGE is ignored." (setq marker mh-x-image-marker cache-filename mh-x-image-url-cache-file temp-file mh-x-image-temp-file)) - (when mh-convert-executable - (call-process mh-convert-executable nil nil nil "-resize" "96x48" - temp-file cache-filename)) - (if (file-exists-p cache-filename) - (mh-x-image-display cache-filename marker) - (make-symbolic-link mh-x-image-cache-directory cache-filename t)) + (cond + ;; Check if we have `convert' + ((eq mh-x-image-scaling-function 'ignore) + (message "The `convert' program is needed to display X-Image-URL") + (mh-x-image-set-download-state cache-filename 'try-again)) + ;; Scale fetched image + ((and (funcall mh-x-image-scaling-function temp-file cache-filename) + nil)) + ;; Attempt to display image if we have it + ((file-exists-p cache-filename) + (mh-x-image-display cache-filename marker)) + ;; We didn't find the image. Should we try to display it the next time? + (t (mh-x-image-set-download-state cache-filename 'try-again))) (ignore-errors (set-marker marker nil) (delete-process process) (kill-buffer wget-buffer) (delete-file temp-file))))) +(defun mh-x-image-url-sane-p (url) + "Check if URL is something sensible." + (let ((len (length url))) + (cond ((< len 5) nil) + ((not (equal (substring url 0 5) "http:")) nil) + ((> len 100) nil) + (t t)))) + (defun mh-x-image-url-display (url) "Display image from location URL. If the URL isn't present in the cache then it is fetched with wget." - (let ((cache-filename (mh-x-image-url-cache-canonicalize url)) - (marker (set-marker (make-marker) (point)))) - (cond ((file-exists-p cache-filename) + (let* ((cache-filename (mh-x-image-url-cache-canonicalize url)) + (state (mh-x-image-get-download-state cache-filename)) + (marker (set-marker (make-marker) (point)))) + (set (make-local-variable 'mh-x-image-marker) marker) + (cond ((not (mh-x-image-url-sane-p url))) + ((eq state 'ok) (mh-x-image-display cache-filename marker)) + ((or (not mh-wget-executable) + (eq mh-x-image-scaling-function 'ignore))) + ((eq state 'never)) ((not mh-fetch-x-image-url) (set-marker marker nil)) - ((and (not (file-exists-p mh-x-image-cache-directory)) - (call-process "mkdir" nil nil nil mh-x-image-cache-directory) - nil)) - ((and (file-exists-p mh-x-image-cache-directory) - (file-directory-p mh-x-image-cache-directory)) + ((eq state 'try-again) + (mh-x-image-set-download-state cache-filename nil) + (mh-x-image-url-fetch-image url cache-filename marker + 'mh-x-image-scale-and-display)) + ((and (eq mh-fetch-x-image-url 'ask) + (not (y-or-n-p (format "Fetch %s? " url)))) + (mh-x-image-set-download-state cache-filename 'never)) + ((eq state nil) (mh-x-image-url-fetch-image url cache-filename marker 'mh-x-image-scale-and-display))))) @@ -1386,27 +1556,32 @@ If the URL isn't present in the cache then it is fetched with wget." If optional arg MSG is non-nil, display that message instead." (if mh-showing-mode (mh-show msg))) -(defun mh-show (&optional message) +(defun mh-show (&optional message redisplay-flag) "Show message at cursor. If optional argument MESSAGE is non-nil, display that message instead. Force a two-window display with the folder window on top (size given by the variable `mh-summary-height') and the show buffer below it. If the message is already visible, display the start of the message. +If REDISPLAY-FLAG is non-nil, the default when called interactively, the +message is redisplayed even if the show buffer was already displaying the +correct message. + Display of the message is controlled by setting the variables `mh-clean-message-header-flag' and `mhl-formfile'. The default behavior is to scroll uninteresting headers off the top of the window. Type \"\\[mh-header-display]\" to see the message with all its headers." - (interactive) - (and mh-showing-with-headers - (or mhl-formfile mh-clean-message-header-flag) - (mh-invalidate-show-buffer)) + (interactive (list nil t)) + (when (or redisplay-flag + (and mh-showing-with-headers + (or mhl-formfile mh-clean-message-header-flag))) + (mh-invalidate-show-buffer)) (mh-show-msg message)) -(defun mh-show-mouse (EVENT) +(defun mh-show-mouse (event) "Move point to mouse EVENT and show message." (interactive "e") - (mouse-set-point EVENT) + (mouse-set-point event) (mh-show)) (defun mh-summary-height () @@ -1428,10 +1603,12 @@ arguments, after the message has been displayed." (let ((folder mh-current-folder) (folders (list mh-current-folder)) (clean-message-header mh-clean-message-header-flag) - (show-window (get-buffer-window mh-show-buffer))) + (show-window (get-buffer-window mh-show-buffer)) + (display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag)) (if (not (eq (next-window (minibuffer-window)) (selected-window))) (delete-other-windows)) ; force ourself to the top window (mh-in-show-buffer (mh-show-buffer) + (setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag) (if (and show-window (equal (mh-msg-filename msg folder) buffer-file-name)) (progn ;just back up to start @@ -1443,6 +1620,9 @@ arguments, after the message has been displayed." (shrink-window (- (window-height) (or mh-summary-height (mh-summary-height))))) (mh-recenter nil) + ;; The following line is a nop which forces update of the scan line so + ;; that font-lock will update it (if needed)... + (mh-notate nil nil mh-cmd-note) (if (not (memq msg mh-seen-list)) (setq mh-seen-list (cons msg mh-seen-list))) (when mh-update-sequences-after-mh-show-flag @@ -1518,8 +1698,8 @@ Sets the current buffer to the show buffer." ;; Bind variables in folder buffer in case they are local (let ((formfile mhl-formfile) (clean-message-header mh-clean-message-header-flag) - (invisible-headers mh-invisible-headers) - (visible-headers mh-visible-headers) + (invisible-headers mh-invisible-header-fields-compiled) + (visible-headers nil) (msg-filename (mh-msg-filename msg-num folder-name)) (show-buffer mh-show-buffer) (mm-inline-media-tests mh-mm-inline-media-tests)) @@ -1596,7 +1776,10 @@ Sets the current buffer to the show buffer." Header is cleaned from START to the end of the message header. INVISIBLE-HEADERS contains a regular expression specifying lines to delete from the header. VISIBLE-HEADERS contains a regular expression specifying the -lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil." +lines to display. INVISIBLE-HEADERS is ignored if VISIBLE-HEADERS is non-nil. + +Note that MH-E no longer supports the `mh-visible-headers' variable, so +this function could be trimmed of this feature too." (let ((case-fold-search t) (buffer-read-only nil) (after-change-functions nil)) ;Work around emacs-20 font-lock bug @@ -1639,8 +1822,7 @@ If NOTATION is nil then no change in the buffer occurs." (with-mh-folder-updating (t) (beginning-of-line) (forward-char offset) - (let* ((change-stack-flag (and (stringp notation) - (equal offset (1+ mh-cmd-note)) + (let* ((change-stack-flag (and (equal offset (1+ mh-cmd-note)) (not (eq notation mh-note-seq)))) (msg (and change-stack-flag (or msg (mh-get-msg-num nil)))) (stack (and msg (gethash msg mh-sequence-notation-history))) @@ -1652,7 +1834,7 @@ If NOTATION is nil then no change in the buffer occurs." ;; at the bottom of the stack. If the sequence is deleted, ;; the correct notation will be shown. (setf (gethash msg mh-sequence-notation-history) - (reverse (cons (aref notation 0) (cdr (reverse stack))))) + (reverse (cons notation (cdr (reverse stack))))) ;; Since we don't have any sequence notations in the way, just ;; notate the scan line. (delete-char 1) @@ -1660,25 +1842,6 @@ If NOTATION is nil then no change in the buffer occurs." (when change-stack-flag (mh-thread-update-scan-line-map msg notation offset))))))) -(defun mh-find-msg-get-num (step) - "Return the message number of the message nearest the cursor. -Jumps over non-message lines, such as inc errors. -If we have to search, STEP tells whether to search forward or backward." - (or (mh-get-msg-num nil) - (let ((msg-num nil) - (nreverses 0)) - (while (and (not msg-num) - (< nreverses 2)) - (cond ((eobp) - (setq step -1) - (setq nreverses (1+ nreverses))) - ((bobp) - (setq step 1) - (setq nreverses (1+ nreverses)))) - (forward-line step) - (setq msg-num (mh-get-msg-num nil))) - msg-num))) - (defun mh-goto-msg (number &optional no-error-if-no-message dont-show) "Position the cursor at message NUMBER. Optional non-nil second argument NO-ERROR-IF-NO-MESSAGE means return nil @@ -1699,10 +1862,6 @@ Non-nil third argument DONT-SHOW means not to show the message." (or dont-show (not return-value) (mh-maybe-show number)) return-value)) -(defun mh-msg-search-pat (n) - "Return a search pattern for message N in the scan listing." - (format mh-scan-msg-search-regexp n)) - (defun mh-get-profile-field (field) "Find and return the value of FIELD in the current buffer. Returns nil if the field is not in the buffer." @@ -1716,120 +1875,65 @@ Returns nil if the field is not in the buffer." (end-of-line) (buffer-substring start (point))))))) -(defvar mail-user-agent) -(defvar read-mail-command) - (defvar mh-find-path-run nil "Non-nil if `mh-find-path' has been run already.") (defun mh-find-path () - "Set `mh-progs', `mh-lib', and `mh-lib-progs' variables. + "Set variables from user's MH profile. Set `mh-user-path', `mh-draft-folder', `mh-unseen-seq', `mh-previous-seq', `mh-inbox' from user's MH profile. The value of `mh-find-path-hook' is a list of functions to be called, with no arguments, after these variable have been set." - (mh-find-progs) + (mh-variants) (unless mh-find-path-run (setq mh-find-path-run t) - (setq read-mail-command 'mh-rmail) - (setq mail-user-agent 'mh-e-user-agent)) - (save-excursion - ;; Be sure profile is fully expanded before switching buffers - (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) - (set-buffer (get-buffer-create mh-temp-buffer)) - (setq buffer-offer-save nil) ;for people who set default to t - (erase-buffer) - (condition-case err - (insert-file-contents profile) - (file-error - (mh-install profile err))) - (setq mh-user-path (mh-get-profile-field "Path:")) - (if (not mh-user-path) - (setq mh-user-path "Mail")) - (setq mh-user-path - (file-name-as-directory - (expand-file-name mh-user-path (expand-file-name "~")))) - (unless mh-x-image-cache-directory - (setq mh-x-image-cache-directory - (expand-file-name ".mhe-x-image-cache" mh-user-path))) - (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) - (if mh-draft-folder - (progn - (if (not (mh-folder-name-p mh-draft-folder)) - (setq mh-draft-folder (format "+%s" mh-draft-folder))) - (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) - (error "Draft folder \"%s\" not found. Create it and try again" - (mh-expand-file-name mh-draft-folder))))) - (setq mh-inbox (mh-get-profile-field "Inbox:")) - (cond ((not mh-inbox) - (setq mh-inbox "+inbox")) - ((not (mh-folder-name-p mh-inbox)) - (setq mh-inbox (format "+%s" mh-inbox)))) - (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) - (if mh-unseen-seq - (setq mh-unseen-seq (intern mh-unseen-seq)) - (setq mh-unseen-seq 'unseen)) ;old MH default? - (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) - (if mh-previous-seq - (setq mh-previous-seq (intern mh-previous-seq))) - (run-hooks 'mh-find-path-hook) - (mh-collect-folder-names)))) + (save-excursion + ;; Be sure profile is fully expanded before switching buffers + (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile")))) + (set-buffer (get-buffer-create mh-temp-buffer)) + (setq buffer-offer-save nil) ;for people who set default to t + (erase-buffer) + (condition-case err + (insert-file-contents profile) + (file-error + (mh-install profile err))) + (setq mh-user-path (mh-get-profile-field "Path:")) + (if (not mh-user-path) + (setq mh-user-path "Mail")) + (setq mh-user-path + (file-name-as-directory + (expand-file-name mh-user-path (expand-file-name "~")))) + (unless mh-x-image-cache-directory + (setq mh-x-image-cache-directory + (expand-file-name ".mhe-x-image-cache" mh-user-path))) + (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:")) + (if mh-draft-folder + (progn + (if (not (mh-folder-name-p mh-draft-folder)) + (setq mh-draft-folder (format "+%s" mh-draft-folder))) + (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) + (error + "Draft folder \"%s\" not found. Create it and try again" + (mh-expand-file-name mh-draft-folder))))) + (setq mh-inbox (mh-get-profile-field "Inbox:")) + (cond ((not mh-inbox) + (setq mh-inbox "+inbox")) + ((not (mh-folder-name-p mh-inbox)) + (setq mh-inbox (format "+%s" mh-inbox)))) + (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:")) + (if mh-unseen-seq + (setq mh-unseen-seq (intern mh-unseen-seq)) + (setq mh-unseen-seq 'unseen)) ;old MH default? + (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:")) + (if mh-previous-seq + (setq mh-previous-seq (intern mh-previous-seq))) + (run-hooks 'mh-find-path-hook) + (mh-collect-folder-names))))) (defun mh-file-command-p (file) "Return t if file FILE is the name of a executable regular file." (and (file-regular-p file) (file-executable-p file))) -(defun mh-find-progs () - "Find the directories for the installed MH/nmh binaries and config files. -Set the `mh-progs' and `mh-lib', and `mh-lib-progs' variables to the -directory names and set `mh-nmh-flag' if we detect nmh instead of MH." - (unless (and mh-progs mh-lib mh-lib-progs) - (let ((path (or (mh-path-search exec-path "mhparam") - (mh-path-search '("/usr/local/nmh/bin" ; nmh default - "/usr/local/bin/mh/" - "/usr/local/mh/" - "/usr/bin/mh/" ;Ultrix 4.2, Linux - "/usr/new/mh/" ;Ultrix <4.2 - "/usr/contrib/mh/bin/" ;BSDI - "/usr/pkg/bin/" ; NetBSD - "/usr/local/bin/" - ) - "mhparam")))) - (if (not path) - (error "Unable to find the `mhparam' command")) - (save-excursion - (let ((tmp-buffer (get-buffer-create mh-temp-buffer))) - (set-buffer tmp-buffer) - (unwind-protect - (progn - (call-process (expand-file-name "mhparam" path) - nil '(t nil) nil "libdir" "etcdir") - (goto-char (point-min)) - (if (search-forward-regexp "^libdir:\\s-\\(\\S-+\\)\\s-*$" - nil t) - (setq mh-lib-progs (match-string 1) - mh-lib mh-lib-progs - mh-progs path)) - (goto-char (point-min)) - (if (search-forward-regexp "^etcdir:\\s-\\(\\S-+\\)\\s-*$" - nil t) - (setq mh-lib (match-string 1) - mh-nmh-flag t))) - (kill-buffer tmp-buffer)))) - (unless (and mh-progs mh-lib mh-lib-progs) - (error "Unable to determine paths from `mhparam' command")) - (setq mh-flists-present-flag - (file-exists-p (expand-file-name "flists" mh-progs)))))) - -(defun mh-path-search (path file) - "Search PATH, a list of directory names, for FILE. -Returns the element of PATH that contains FILE, or nil if not found." - (while (and path - (not (funcall 'mh-file-command-p - (expand-file-name file (car path))))) - (setq path (cdr path))) - (car path)) - (defvar mh-no-install nil) ;do not run install-mh (defun mh-install (profile error-val) @@ -1911,18 +2015,18 @@ not updated." (let ((entry (mh-find-seq seq)) (internal-seq-flag (mh-internal-seq seq))) (if (and msgs (atom msgs)) (setq msgs (list msgs))) - (unless internal-flag - (mh-add-to-sequence seq msgs) - (when (not dont-annotate-flag) - (mh-iterate-on-range msg msgs - (unless (memq msg (cdr entry)) - (mh-add-sequence-notation msg internal-seq-flag))))) (if (null entry) (setq mh-seq-list (cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) mh-seq-list)) (if msgs (setcdr entry (mh-canonicalize-sequence - (append msgs (mh-seq-msgs entry)))))))) + (append msgs (mh-seq-msgs entry)))))) + (unless internal-flag + (mh-add-to-sequence seq msgs) + (when (not dont-annotate-flag) + (mh-iterate-on-range msg msgs + (unless (memq msg (cdr entry)) + (mh-add-sequence-notation msg internal-seq-flag))))))) (defun mh-canonicalize-sequence (msgs) "Sort MSGS in decreasing order and remove duplicates." @@ -2076,12 +2180,15 @@ aren't usually mail folders are hidden." (goto-char (point-min)) (while (not (and (eolp) (bolp))) (goto-char (line-end-position)) - (let ((has-pos (search-backward " has " (line-beginning-position) t))) + (let ((start-pos (line-beginning-position)) + (has-pos (search-backward " has " (line-beginning-position) t))) (when (integerp has-pos) (while (equal (char-after has-pos) ? ) (decf has-pos)) (incf has-pos) - (let* ((name (buffer-substring (line-beginning-position) has-pos)) + (while (equal (char-after start-pos) ? ) + (incf start-pos)) + (let* ((name (buffer-substring start-pos has-pos)) (first-char (aref name 0)) (last-char (aref name (1- (length name))))) (unless (member first-char '(?. ?# ?,)) @@ -2189,7 +2296,9 @@ whether the completion is over." 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-local-completion-map mh-folder-completion-map) + (let ((minibuffer-completing-file-name t) + (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 'mh-folder-hist default)) @@ -2206,11 +2315,10 @@ non-nil then the function will accept the folder +, which means all folders when used in searching." (if (null default) (setq default "")) - (let* ((default-string (cond (default-string (format " [%s]? " - default-string)) - ((equal "" default) "? ") - (t (format " [%s]? " default)))) - (prompt (format "%s folder%s" prompt default-string)) + (let* ((default-string (cond (default-string (format "[%s] " default-string)) + ((equal "" default) "") + (t (format "[%s] " default)))) + (prompt (format "%s folder: %s" prompt default-string)) (mh-current-folder-name mh-current-folder) read-name folder-name) (while (and (setq read-name (mh-folder-completing-read @@ -2452,6 +2560,13 @@ Put the output into buffer after point. Set mark after inserted text." (setq l (cdr l))) new-list)) +(defun mh-replace-string (old new) + "Replace all occurrences of OLD with NEW in the current buffer." + (goto-char (point-min)) + (let ((case-fold-search t)) + (while (search-forward old nil t) + (replace-match new t t)))) + (defun mh-replace-in-string (regexp newtext string) "Replace REGEXP with NEWTEXT everywhere in STRING and return result. NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. diff --git a/lisp/net/ange-ftp.el b/lisp/net/ange-ftp.el index 8e9d0bda5af..c1f3c0a8d52 100644 --- a/lisp/net/ange-ftp.el +++ b/lisp/net/ange-ftp.el @@ -1014,7 +1014,7 @@ or nil meaning don't change it." (defun ange-ftp-hash-entry-exists-p (key tbl) "Return whether there is an association for KEY in TABLE." - (not (eq (gethash key tbl 'unknown) 'unknown))) + (and tbl (not (eq (gethash key tbl 'unknown) 'unknown)))) (defun ange-ftp-hash-table-keys (tbl) "Return a sorted list of all the active keys in TABLE, as strings." @@ -1771,7 +1771,7 @@ good, skip, fatal, or unknown." ange-ftp-gateway-program ange-ftp-gateway-host))) (ftp (mapconcat 'identity args " "))) - (process-kill-without-query proc) + (set-process-query-on-exit-flag proc nil) (set-process-sentinel proc 'ange-ftp-gwp-sentinel) (set-process-filter proc 'ange-ftp-gwp-filter) (save-excursion @@ -1880,7 +1880,7 @@ been queued with no result. CONT will still be called, however." (start-process " *nslookup*" " *nslookup*" ange-ftp-nslookup-program host))) (res host)) - (process-kill-without-query proc) + (set-process-query-on-exit-flag proc nil) (save-excursion (set-buffer (process-buffer proc)) (while (memq (process-status proc) '(run open)) @@ -1938,7 +1938,7 @@ on the gateway machine to do the ftp instead." (set-buffer (process-buffer proc)) (goto-char (point-max)) (set-marker (process-mark proc) (point))) - (process-kill-without-query proc) + (set-process-query-on-exit-flag proc nil) (set-process-sentinel proc 'ange-ftp-process-sentinel) (set-process-filter proc 'ange-ftp-process-filter) ;; On Windows, the standard ftp client buffers its output (because @@ -2919,11 +2919,8 @@ NO-ERROR, if a listing for DIRECTORY cannot be obtained." ;; error message. (gethash "." ent)) ;; Child lookup failed, so try the parent. - (let ((table (ange-ftp-get-files dir 'no-error))) - ;; If the dir doesn't exist, don't use it as a hash table. - (and table - (ange-ftp-hash-entry-exists-p file - table))))))) + (ange-ftp-hash-entry-exists-p + file (ange-ftp-get-files dir 'no-error)))))) (defun ange-ftp-get-file-entry (name) "Given NAME, return the given file entry. @@ -3374,11 +3371,11 @@ system TYPE.") (setq file (ange-ftp-expand-file-name file)) (if (ange-ftp-ftp-name file) (condition-case nil - (let ((file-ent - (gethash - (ange-ftp-get-file-part file) - (ange-ftp-get-files (file-name-directory file))))) - (and (stringp file-ent) file-ent)) + (let ((ent (ange-ftp-get-files (file-name-directory file)))) + (and ent + (stringp (setq ent + (gethash (ange-ftp-get-file-part file) ent))) + ent)) ;; If we can't read the parent directory, just assume ;; this file is not a symlink. ;; This makes it possible to access a directory that diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 02b076483c1..cda0d41fd8d 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2055,7 +2055,7 @@ target of the symlink differ." (defun tramp-handle-file-truename (filename &optional counter prev-dirs) "Like `file-truename' for tramp files." - (with-parsed-tramp-file-name filename nil + (with-parsed-tramp-file-name (expand-file-name filename) nil (let* ((steps (tramp-split-string localname "/")) (localnamedir (tramp-let-maybe directory-sep-char ?/ ;for XEmacs (file-name-as-directory localname))) @@ -2299,32 +2299,33 @@ If it doesn't exist, generate a new one." (unless (buffer-file-name) (error "Can't set-visited-file-modtime: buffer `%s' not visiting a file" (buffer-name))) - (when time-list - (tramp-run-real-handler 'set-visited-file-modtime (list time-list))) - (let ((f (buffer-file-name)) - (coding-system-used nil)) - (with-parsed-tramp-file-name f nil - (let* ((attr (file-attributes f)) - (modtime (nth 5 attr))) - ;; We use '(0 0) as a don't-know value. See also - ;; `tramp-handle-file-attributes-with-ls'. - (when (boundp 'last-coding-system-used) - (setq coding-system-used last-coding-system-used)) - (if (not (equal modtime '(0 0))) - (tramp-run-real-handler 'set-visited-file-modtime (list modtime)) - (save-excursion - (tramp-send-command - multi-method method user host - (format "%s -ild %s" - (tramp-get-ls-command multi-method method user host) - (tramp-shell-quote-argument localname))) - (tramp-wait-for-output) - (setq attr (buffer-substring (point) - (progn (end-of-line) (point))))) - (setq tramp-buffer-file-attributes attr)) - (when (boundp 'last-coding-system-used) - (setq last-coding-system-used coding-system-used)) - nil)))) + (if time-list + (tramp-run-real-handler 'set-visited-file-modtime (list time-list)) + (let ((f (buffer-file-name)) + (coding-system-used nil)) + (with-parsed-tramp-file-name f nil + (let* ((attr (file-attributes f)) + ;; '(-1 65535) means file doesn't exists yet. + (modtime (or (nth 5 attr) '(-1 65535)))) + ;; We use '(0 0) as a don't-know value. See also + ;; `tramp-handle-file-attributes-with-ls'. + (when (boundp 'last-coding-system-used) + (setq coding-system-used last-coding-system-used)) + (if (not (equal modtime '(0 0))) + (tramp-run-real-handler 'set-visited-file-modtime (list modtime)) + (save-excursion + (tramp-send-command + multi-method method user host + (format "%s -ild %s" + (tramp-get-ls-command multi-method method user host) + (tramp-shell-quote-argument localname))) + (tramp-wait-for-output) + (setq attr (buffer-substring (point) + (progn (end-of-line) (point))))) + (setq tramp-buffer-file-attributes attr)) + (when (boundp 'last-coding-system-used) + (setq last-coding-system-used coding-system-used)) + nil))))) ;; CCC continue here @@ -3811,8 +3812,11 @@ This will break if COMMAND prints a newline, followed by the value of (unless (equal curbuf (current-buffer)) (error "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - (when (eq visit t) - (set-visited-file-modtime)) + (when (or (eq visit t) (stringp visit)) + (set-visited-file-modtime + ;; We must pass modtime explicitely, because filename can be different + ;; from (buffer-file-name), f.e. if `file-precious-flag' is set. + (nth 5 (file-attributes filename)))) ;; Make `last-coding-system-used' have the right value. (when (boundp 'last-coding-system-used) (setq last-coding-system-used coding-system-used)) @@ -5847,7 +5851,8 @@ locale to C and sets up the remote shell search path." multi-method method user host (concat "tramp_file_attributes () {\n" tramp-remote-perl - " -e '" tramp-perl-file-attributes "' $1 $2 2>/dev/null\n" + " -e '" tramp-perl-file-attributes "'" + " \"$1\" \"$2\" 2>/dev/null\n" "}")) (tramp-wait-for-output) (unless (tramp-method-out-of-band-p multi-method method user host) diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index b3223d7a46e..46b33b2d50f 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.39" +(defconst tramp-version "2.0.44" "This version of Tramp.") (defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org" diff --git a/lisp/novice.el b/lisp/novice.el index 159c9a96780..ca9a06769d5 100644 --- a/lisp/novice.el +++ b/lisp/novice.el @@ -1,6 +1,7 @@ ;;; novice.el --- handling of disabled commands ("novice mode") for Emacs -;; Copyright (C) 1985, 1986, 1987, 1994, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1985, 1986, 1987, 1994, 2002, 2004 +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: internal, help @@ -36,12 +37,17 @@ ;; and the keys are returned by (this-command-keys). ;;;###autoload -(defvar disabled-command-hook 'disabled-command-hook +(defvar disabled-command-function 'disabled-command-function "Function to call to handle disabled commands. If nil, the feature is disabled, i.e., all commands work normally.") +(defvaralias 'disabled-command-hook 'disabled-command-function) +(make-obsolete-variable + 'disabled-command-hook + "use the variable `disabled-command-function' instead." "21.4") + ;;;###autoload -(defun disabled-command-hook (&rest ignore) +(defun disabled-command-function (&rest ignore) (let (char) (save-window-excursion (with-output-to-temp-buffer "*Help*" @@ -91,7 +97,7 @@ SPC to try the command just this once, but leave it disabled. (ding) (message "Please type y, n, ! or SPC (the space bar): ")))) (if (= char ?!) - (setq disabled-command-hook nil)) + (setq disabled-command-function nil)) (if (= char ?y) (if (and user-init-file (not (string= "" user-init-file)) @@ -104,7 +110,8 @@ SPC to try the command just this once, but leave it disabled. ;;;###autoload (defun enable-command (command) "Allow COMMAND to be executed without special confirmation from now on. -The user's .emacs file is altered so that this will apply +COMMAND must be a symbol. +This command alters the user's .emacs file so that this will apply to future sessions." (interactive "CEnable command: ") (put command 'disabled nil) @@ -141,7 +148,8 @@ to future sessions." ;;;###autoload (defun disable-command (command) "Require special confirmation to execute COMMAND from now on. -The user's .emacs file is altered so that this will apply +COMMAND must be a symbol. +This command alters the user's .emacs file so that this will apply to future sessions." (interactive "CDisable command: ") (if (not (commandp command)) diff --git a/lisp/pcvs-parse.el b/lisp/pcvs-parse.el index c1726ee84c7..84dbf218581 100644 --- a/lisp/pcvs-parse.el +++ b/lisp/pcvs-parse.el @@ -1,7 +1,7 @@ ;;; pcvs-parse.el --- the CVS output parser -;; Copyright (C) 1991,92,93,94,95,96,97,98,99,2000,02,2003 -;; Free Software Foundation, Inc. +;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, +;; 2000, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@cs.yale.edu> ;; Keywords: pcl-cvs @@ -370,7 +370,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." ;; File you removed still exists. Ignore (will be noted as removed). (cvs-match ".* should be removed and is still there$") ;; just a note - (cvs-match "use '.+ commit' to \\sw+ th\\sw+ files? permanently$") + (cvs-match "use ['`].+ commit' to \\sw+ th\\sw+ files? permanently$") ;; [add,status] followed by a more complete status description anyway (and (cvs-match "nothing known about \\(.*\\)$" (path 1)) (cvs-parsed-fileinfo 'DEAD path 'trust)) @@ -492,12 +492,14 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." :head-rev head-rev)))) (defun cvs-parse-commit () - (let (path base-rev subtype) + (let (path file base-rev subtype) (cvs-or (and - (cvs-match "\\(Checking in\\|Removing\\) \\(.*\\);$" (path 2)) - (cvs-match ".*,v <-- .*$") + (cvs-or + (cvs-match "\\(Checking in\\|Removing\\) \\(.*\\);$" (path 2)) + t) + (cvs-match ".*,v <-- \\(.*\\)$" (file 1)) (cvs-or ;; deletion (cvs-match "new revision: delete; previous revision: \\([0-9.]*\\)$" @@ -508,7 +510,7 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." ;; update (cvs-match "new revision: \\([0-9.]*\\); previous revision: .*$" (subtype 'COMMITTED) (base-rev 1))) - (cvs-match "done$") + (cvs-or (cvs-match "done$") t) (progn ;; Try to remove the temp files used by VC. (vc-delete-automatic-version-backups (expand-file-name path)) @@ -516,7 +518,8 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." ;; because `cvs commit' might begin by a series of Examining messages ;; so the processing of the actual checkin messages might begin with ;; a `current-dir' set to something different from "" - (cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype) path 'trust + (cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype) + (or path file) (if path 'trust) :base-rev base-rev))) ;; useless message added before the actual addition: ignored @@ -525,5 +528,5 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'." (provide 'pcvs-parse) -;;; arch-tag: 35418375-1a23-40a0-957d-96b0262f91d6 +;; arch-tag: 35418375-1a23-40a0-957d-96b0262f91d6 ;;; pcvs-parse.el ends here diff --git a/lisp/printing.el b/lisp/printing.el index 22a3f762ab6..08303e0595d 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -974,7 +974,7 @@ Please send all bug fixes and enhancements to (and (string< ps-print-version "6.6.4") - (error "`printing' requires `ps-print' package version 6.6.4 or later.")) + (error "`printing' requires `ps-print' package version 6.6.4 or later")) (eval-and-compile @@ -4254,7 +4254,7 @@ are both set to t." (pr-ps-buffer-ps-print (if (integerp n-up) (min (max n-up 1) 100) - (error "n-up must be an integer greater than zero.")) + (error "n-up must be an integer greater than zero")) filename))) @@ -5031,7 +5031,7 @@ non-nil." (let ((item (cdr (assq value pr-ps-utility-alist)))) (or item (error - "Invalid PostScript utility name `%s' for variable `pr-ps-utility'." + "Invalid PostScript utility name `%s' for variable `pr-ps-utility'" value)) (setq pr-ps-utility value) (pr-eval-alist (nthcdr 9 item))) @@ -5042,7 +5042,7 @@ non-nil." (let ((ps (cdr (assq value pr-ps-printer-alist)))) (or ps (error - "Invalid PostScript printer name `%s' for variable `pr-ps-name'." + "Invalid PostScript printer name `%s' for variable `pr-ps-name'" value)) (setq pr-ps-name value pr-ps-command (pr-dosify-file-name (nth 0 ps)) @@ -5068,7 +5068,7 @@ non-nil." (defun pr-txt-set-printer (value) (let ((txt (cdr (assq value pr-txt-printer-alist)))) (or txt - (error "Invalid text printer name `%s' for variable `pr-txt-name'." + (error "Invalid text printer name `%s' for variable `pr-txt-name'" value)) (setq pr-txt-name value pr-txt-command (pr-dosify-file-name (nth 0 txt)) @@ -5121,7 +5121,7 @@ non-nil." (setq global nil))) (and inherits (if (memq inherits old) - (error "Circular inheritance for `%S'." inherits) + (error "Circular inheritance for `%S'" inherits) (setq local-list (pr-eval-setting-alist inherits global (cons inherits old))))) @@ -5349,7 +5349,7 @@ non-nil." (defun pr-switches (switches mess) (or (listp switches) - (error "%S should have a list of strings." mess)) + (error "%S should have a list of strings" mess)) (ps-flatten-list ; dynamic evaluation (mapcar 'ps-eval-switch switches))) diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index c9bfbd76c23..fc1d2d46ab3 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -33,7 +33,7 @@ ;;; for lookup and completion in Ada mode. ;;; ;;; If a file *.`adp' exists in the ada-file directory, then it is -;;; read for configuration informations. It is read only the first +;;; read for configuration informations. It is read only the first ;;; time a cross-reference is asked for, and is not read later. ;;; You need Emacs >= 20.2 to run this package @@ -55,26 +55,25 @@ Otherwise create either a new buffer or a new frame." (defcustom ada-xref-create-ali nil "*If non-nil, run gcc whenever the cross-references are not up-to-date. -If nil, the cross-reference mode will never run gcc." +If nil, the cross-reference mode never runs gcc." :type 'boolean :group 'ada) (defcustom ada-xref-confirm-compile nil - "*If non-nil, always ask for user confirmation before compiling or running -the application." + "*If non-nil, ask for confirmation before compiling or running the application." :type 'boolean :group 'ada) (defcustom ada-krunch-args "0" - "*Maximum number of characters for filenames created by gnatkr. -Set to 0, if you don't use crunched filenames. This should be a string." + "*Maximum number of characters for filenames created by `gnatkr'. +Set to 0, if you don't use crunched filenames. This should be a string." :type 'string :group 'ada) (defcustom ada-gnatls-args '("-v") - "*Arguments to pass to gnatfind when the location of the runtime is searched. -Typical use is to pass --RTS=soft-floats on some systems that support it. + "*Arguments to pass to `gnatfind' to find location of the runtime. +Typical use is to pass `--RTS=soft-floats' on some systems that support it. -You can also add -I- if you do not want the current directory to be included. +You can also add `-I-' if you do not want the current directory to be included. Otherwise, going from specs to bodies and back will first look for files in the -current directory. This only has an impact if you are not using project files, +current directory. This only has an impact if you are not using project files, but only ADA_INCLUDE_PATH." :type '(repeat string) :group 'ada) @@ -91,14 +90,14 @@ but only ADA_INCLUDE_PATH." :type 'string :group 'ada) (defcustom ada-prj-default-gnatmake-opt "-g" - "Default options for gnatmake." + "Default options for `gnatmake'." :type 'string :group 'ada) (defcustom ada-prj-gnatfind-switches "-rf" - "Default switches to use for gnatfind. -You should modify this variable, for instance to add -a, if you are working + "Default switches to use for `gnatfind'. +You should modify this variable, for instance to add `-a', if you are working in an environment where most ALI files are write-protected. -The command gnatfind is used every time you choose the menu +The command `gnatfind' is used every time you choose the menu \"Show all references\"." :type 'string :group 'ada) @@ -106,12 +105,12 @@ The command gnatfind is used every time you choose the menu (concat "${cross_prefix}gnatmake -u -c ${gnatmake_opt} ${full_current} -cargs" " ${comp_opt}") "*Default command to be used to compile a single file. -Emacs will add the filename at the end of this command. This is the same +Emacs will add the filename at the end of this command. This is the same syntax as in the project file." :type 'string :group 'ada) (defcustom ada-prj-default-debugger "${cross_prefix}gdb" - "*Default name of the debugger. We recommend either `gdb', + "*Default name of the debugger. We recommend either `gdb', `gdb --emacs_gdbtk' or `ddd --tty -fullname'." :type 'string :group 'ada) @@ -129,7 +128,7 @@ this string is not empty." :type '(file :must-match t) :group 'ada) (defcustom ada-gnatstub-opts "-q -I${src_dir}" - "*List of the options to pass to gnatsub to generate the body of a package. + "*List of the options to pass to `gnatsub' to generate the body of a package. This has the same syntax as in the project file (with variable substitution)." :type 'string :group 'ada) @@ -139,7 +138,7 @@ Otherwise, ask the user for the name of the project file to use." :type 'boolean :group 'ada) (defconst is-windows (memq system-type (quote (windows-nt))) - "True if we are running on windows NT or windows 95.") + "True if we are running on Windows NT or Windows 95.") (defcustom ada-tight-gvd-integration nil "*If non-nil, a new Emacs frame will be swallowed in GVD when debugging. @@ -149,7 +148,7 @@ If GVD is not the debugger used, nothing happens." (defcustom ada-xref-search-with-egrep t "*If non-nil, use egrep to find the possible declarations for an entity. This alternate method is used when the exact location was not found in the -information provided by GNAT. However, it might be expensive if you have a lot +information provided by GNAT. However, it might be expensive if you have a lot of sources, since it will search in all the files in your project." :type 'boolean :group 'ada) @@ -161,8 +160,8 @@ This hook should be used to support new formats for the project files. If the function can load the file with the given filename, it should create a buffer that contains a conversion of the file to the standard format of the -project files, and return that buffer. (the usual \"src_dir=\" or \"obj_dir=\" -lines). It should return nil if it doesn't know how to convert that project +project files, and return that buffer. (The usual \"src_dir=\" or \"obj_dir=\" +lines.) It should return nil if it doesn't know how to convert that project file.") @@ -192,14 +191,13 @@ Used to go back to these positions.") (if (string-match "cmdproxy.exe" shell-file-name) "cd /d" "cd") - "Command to use to change to a specific directory. On windows systems -using cmdproxy.exe as the shell, we need to use /d or the drive is never -changed.") + "Command to use to change to a specific directory. +On Windows systems using `cmdproxy.exe' as the shell, +we need to use `/d' or the drive is never changed.") (defvar ada-command-separator (if is-windows " && " "\n") - "Separator to use when sending multiple commands to `compile' or -`start-process'. -cmdproxy.exe doesn't recognize multiple-line commands, so we have to use + "Separator to use between multiple commands to `compile' or `start-process'. +`cmdproxy.exe' doesn't recognize multiple-line commands, so we have to use \"&&\" for now.") (defconst ada-xref-pos-ring-max 16 @@ -247,12 +245,12 @@ As always, the values of the project file are defined through properties.") ;; ----------------------------------------------------------------------- (defun ada-quote-cmd (cmd) - "Duplicates all \\ characters in CMD so that it can be passed to `compile'" + "Duplicate all \\ characters in CMD so that it can be passed to `compile'." (mapconcat 'identity (split-string cmd "\\\\") "\\\\")) (defun ada-initialize-runtime-library (cross-prefix) - "Initializes the variables for the runtime library location. -CROSS-PREFIX is the prefix to use for the gnatls command" + "Initialize the variables for the runtime library location. +CROSS-PREFIX is the prefix to use for the gnatls command." (save-excursion (setq ada-xref-runtime-library-specs-path '() ada-xref-runtime-library-ali-path '()) @@ -591,7 +589,7 @@ This is overriden on VMS to convert from VMS filenames to Unix filenames." (defun ada-set-default-project-file (name &optional keep-existing) "Set the file whose name is NAME as the default project file. If KEEP-EXISTING is true and a project file has already been loaded, nothing -is done. This is meant to be used from ada-mode-hook, for instance to force +is done. This is meant to be used from `ada-mode-hook', for instance, to force a project file unless the user has already loaded one." (interactive "fProject file:") (if (or (not keep-existing) @@ -608,7 +606,7 @@ a project file unless the user has already loaded one." If NO-USER-QUESTION is non-nil, use a default file if not project file was found, and do not ask the user. If the buffer is not an Ada buffer, associate it with the default project -file. If none is set, return nil." +file. If none is set, return nil." (let (selected) @@ -711,7 +709,7 @@ The current buffer should be the ada-file buffer." (ada-xref-set-default-prj-values 'project (current-buffer)) ;; Do not use find-file below, since we don't want to show this - ;; buffer. If the file is open through speedbar, we can't use + ;; buffer. If the file is open through speedbar, we can't use ;; find-file anyway, since the speedbar frame is special and does not ;; allow the selection of a file in it. @@ -786,7 +784,7 @@ The current buffer should be the ada-file buffer." ;; Else the file wasn't readable (probably the default project). ;; We initialize it with the current environment variables. ;; We need to add the startup directory in front so that - ;; files locally redefined are properly found. We cannot + ;; files locally redefined are properly found. We cannot ;; add ".", which varies too much depending on what the ;; current buffer is. (set 'project @@ -836,7 +834,7 @@ The current buffer should be the ada-file buffer." ;; No prj file ? => Setup default values ;; Note that nil means that all compilation modes will first look in the - ;; current directory, and only then in the current file's directory. This + ;; current directory, and only then in the current file's directory. This ;; current file is assumed at this point to be in the common source ;; directory. (setq compilation-search-path (list nil default-directory)) @@ -846,10 +844,9 @@ The current buffer should be the ada-file buffer." (defun ada-find-references (&optional pos arg local-only) "Find all references to the entity under POS. Calls gnatfind to find the references. -if ARG is t, the contents of the old *gnatfind* buffer is preserved. -if LOCAL-ONLY is t, only the declarations in the current file are returned." - (interactive "d -P") +If ARG is t, the contents of the old *gnatfind* buffer is preserved. +If LOCAL-ONLY is t, only the declarations in the current file are returned." + (interactive "d\nP") (ada-require-project-file) (let* ((identlist (ada-read-identifier pos)) @@ -872,24 +869,23 @@ P") (defun ada-find-local-references (&optional pos arg) "Find all references to the entity under POS. -Calls gnatfind to find the references. -if ARG is t, the contents of the old *gnatfind* buffer is preserved." - (interactive "d -P") +Calls `gnatfind' to find the references. +If ARG is t, the contents of the old *gnatfind* buffer is preserved." + (interactive "d\nP") (ada-find-references pos arg t)) (defun ada-find-any-references (entity &optional file line column local-only append) "Search for references to any entity whose name is ENTITY. ENTITY was first found the location given by FILE, LINE and COLUMN. -If LOCAL-ONLY is t, then only the references in file will be listed, which +If LOCAL-ONLY is t, then list only the references in FILE, which is much faster. -If APPEND is t, then the output of the command will be append to the existing -buffer *gnatfind* if it exists." +If APPEND is t, then append the output of the command to the existing +buffer `*gnatfind*', if there is one." (interactive "sEntity name: ") (ada-require-project-file) - ;; Prepare the gnatfind command. Note that we must protect the quotes + ;; Prepare the gnatfind command. Note that we must protect the quotes ;; around operators, so that they are correctly handled and can be ;; processed (gnatfind \"+\":...). (let* ((quote-entity @@ -921,7 +917,8 @@ buffer *gnatfind* if it exists." (set-buffer "*gnatfind*") (setq old-contents (buffer-string)))) - (compile-internal command "No more references" "gnatfind") + (let ((compilation-error "reference")) + (compilation-start command)) ;; Hide the "Compilation" menu (save-excursion @@ -941,8 +938,8 @@ buffer *gnatfind* if it exists." ;; ----- Identifier Completion -------------------------------------------- (defun ada-complete-identifier (pos) "Tries to complete the identifier around POS. -The feature is only available if the files where compiled not using the -gnatx -option." +The feature is only available if the files where compiled without +the option `-gnatx'." (interactive "d") (ada-require-project-file) @@ -1026,12 +1023,12 @@ If OTHER-FRAME is non-nil, display the cross-reference in another frame." ;; entity, whose references are not given by GNAT (if (and (file-exists-p ali-file) (file-newer-than-file-p ali-file (ada-file-of identlist))) - (message "No cross-reference found. It might be a predefined entity.") + (message "No cross-reference found--may be a predefined entity.") ;; Else, look in every ALI file, except if the user doesn't want that (if ada-xref-search-with-egrep (ada-find-in-src-path identlist other-frame) - (message "Cross-referencing information is not up-to-date. Please recompile.") + (message "Cross-referencing information is not up-to-date; please recompile.") ))))))) (defun ada-goto-declaration-other-frame (pos) @@ -1052,12 +1049,13 @@ The declation is shown in another frame if `ada-xref-other-buffer' is non-nil." (defun ada-get-absolute-dir-list (dir-list root-dir) "Returns the list of absolute directories found in dir-list. -If a directory is a relative directory, the value of ROOT-DIR is added in -front." +If a directory is a relative directory, add the value of ROOT-DIR in front." (mapcar (lambda (x) (expand-file-name x root-dir)) dir-list)) (defun ada-set-environment () - "Return the new value for process-environment. + "Prepare an environment for Ada compilation. +This returns a new value to use for `process-environment', +but does not actually put it into use. It modifies the source path and object path with the values found in the project file." (let ((include (getenv "ADA_INCLUDE_PATH")) @@ -1082,7 +1080,7 @@ project file." process-environment)))) (defun ada-compile-application (&optional arg) - "Compiles the application, using the command found in the project file. + "Compile the application, using the command found in the project file. If ARG is not nil, ask for user confirmation." (interactive "P") (ada-require-project-file) @@ -1104,7 +1102,7 @@ If ARG is not nil, ask for user confirmation." (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) ;; Insert newlines so as to separate the name of the commands to run - ;; and the output of the commands. this doesn't work with cmdproxy.exe, + ;; and the output of the commands. This doesn't work with cmdproxy.exe, ;; which gets confused by newline characters. (if (not (string-match ".exe" shell-file-name)) (setq cmd (concat cmd "\n\n"))) @@ -1137,7 +1135,7 @@ command, and should be either comp_cmd (default) or check_cmd." (setq cmd (read-from-minibuffer "enter command to compile: " cmd))) ;; Insert newlines so as to separate the name of the commands to run - ;; and the output of the commands. this doesn't work with cmdproxy.exe, + ;; and the output of the commands. This doesn't work with cmdproxy.exe, ;; which gets confused by newline characters. (if (not (string-match ".exe" shell-file-name)) (setq cmd (concat cmd "\n\n"))) @@ -1152,7 +1150,7 @@ If ARG is not nil, ask for user confirmation of the command." (defun ada-run-application (&optional arg) "Run the application. -if ARG is not-nil, asks for user confirmation." +if ARG is not-nil, ask for user confirmation." (interactive) (ada-require-project-file) @@ -1227,7 +1225,7 @@ If ARG is non-nil, ask the user to confirm the command." ;; We make sure that gvd swallows the new frame, not the one the ;; user has been using until now ;; The frame is made invisible initially, so that GtkPlug gets a - ;; chance to fully manage it. Then it works fine with Enlightenment + ;; chance to fully manage it. Then it works fine with Enlightenment ;; as well (let ((frame (make-frame '((visibility . nil))))) (set 'cmd (concat @@ -1297,7 +1295,7 @@ If ARG is non-nil, ask the user to confirm the command." (end-of-buffer) ;; Display both the source window and the debugger window (the former - ;; above the latter). No need to show the debugger window unless it + ;; above the latter). No need to show the debugger window unless it ;; is going to have some relevant information. (if (or (not (string-match "gvd" (comint-arguments cmd 0 0))) (string-match "--tty" cmd)) @@ -1328,8 +1326,8 @@ automatically modifies the setup for all the Ada buffer that use this file." "Update the cross-references for FILE. This in fact recompiles FILE to create ALI-FILE-NAME. This function returns the name of the file that was recompiled to generate -the cross-reference information. Note that the ali file can then be deduced by -replacing the file extension with .ali" +the cross-reference information. Note that the ali file can then be deduced by +replacing the file extension with `.ali'." ;; kill old buffer (if (and ali-file-name (get-file-buffer ali-file-name)) @@ -1338,7 +1336,7 @@ replacing the file extension with .ali" (let* ((name (ada-convert-file-name file)) (body-name (or (ada-get-body-name name) name))) - ;; Always recompile the body when we can. We thus temporarily switch to a + ;; Always recompile the body when we can. We thus temporarily switch to a ;; buffer than contains the body of the unit (save-excursion (let ((body-visible (find-buffer-visiting body-name)) @@ -1347,7 +1345,7 @@ replacing the file extension with .ali" (set-buffer body-visible) (find-file body-name)) - ;; Execute the compilation. Note that we must wait for the end of the + ;; Execute the compilation. Note that we must wait for the end of the ;; process, or the ALI file would still not be available. ;; Unfortunately, the underlying `compile' command that we use is ;; asynchronous. @@ -1377,13 +1375,13 @@ replacing the file extension with .ali" found)) (defun ada-find-ali-file-in-dir (file) - "Find an .ali file in obj_dir. The current buffer must be the Ada file. + "Find an .ali file in obj_dir. The current buffer must be the Ada file. Adds build_dir in front of the search path to conform to gnatmake's behavior, and the standard runtime location at the end." (ada-find-file-in-dir file (ada-xref-get-obj-dir-field))) (defun ada-find-src-file-in-dir (file) - "Find a source file in src_dir. The current buffer must be the Ada file. + "Find a source file in src_dir. The current buffer must be the Ada file. Adds src_dir in front of the search path to conform to gnatmake's behavior, and the standard runtime location at the end." (ada-find-file-in-dir file (ada-xref-get-src-dir-field))) @@ -1400,7 +1398,7 @@ the project file." ;; and look for this file ;; 2- If this file is found: ;; grep the "^U" lines, and make sure we are not reading the - ;; .ali file for a spec file. If we are, go to step 3. + ;; .ali file for a spec file. If we are, go to step 3. ;; 3- If the file is not found or step 2 failed: ;; find the name of the "other file", ie the body, and look ;; for its associated .ali file by subtituing the extension @@ -1408,9 +1406,9 @@ the project file." ;; We must also handle the case of separate packages and subprograms: ;; 4- If no ali file was found, we try to modify the file name by removing ;; everything after the last '-' or '.' character, so as to get the - ;; ali file for the parent unit. If we found an ali file, we check that + ;; ali file for the parent unit. If we found an ali file, we check that ;; it indeed contains the definition for the separate entity by checking - ;; the 'D' lines. This is done repeatedly, in case the direct parent is + ;; the 'D' lines. This is done repeatedly, in case the direct parent is ;; also a separate. (save-excursion @@ -1423,7 +1421,7 @@ the project file." ;; If we have a non-standard file name, and this is a spec, we first ;; look for the .ali file of the body, since this is the one that - ;; contains the most complete information. If not found, we will do what + ;; contains the most complete information. If not found, we will do what ;; we can with the .ali file for the spec... (if (not (string= (file-name-extension file) "ads")) @@ -1476,8 +1474,8 @@ the project file." ;; If still not found, try to recompile the file (if (not ali-file-name) - ;; recompile only if the user asked for this. and search the ali - ;; filename again. We avoid a possible infinite recursion by + ;; Recompile only if the user asked for this, and search the ali + ;; filename again. We avoid a possible infinite recursion by ;; temporarily disabling the automatic compilation. (if ada-xref-create-ali @@ -1485,7 +1483,7 @@ the project file." (concat (file-name-sans-extension (ada-xref-current file)) ".ali")) - (error "Ali file not found. Recompile your file")) + (error "`.ali' file not found; recompile your source file")) ;; same if the .ali file is too old and we must recompile it @@ -1499,7 +1497,7 @@ the project file." (defun ada-get-ada-file-name (file original-file) "Create the complete file name (+directory) for FILE. -The original file (where the user was) is ORIGINAL-FILE. Search in project +The original file (where the user was) is ORIGINAL-FILE. Search in project file for possible paths." (save-excursion @@ -1519,7 +1517,7 @@ file for possible paths." (expand-file-name filename) (error (concat (file-name-nondirectory file) - " not found in src_dir. Please check your project file"))) + " not found in src_dir; please check your project file"))) ))) @@ -1671,13 +1669,13 @@ from the ali file (definition file and places where it is referenced)." (set 'declaration-found nil)))) ;; Still no success ! The ali file must be too old, and we need to - ;; use a basic algorithm based on guesses. Note that this only happens + ;; use a basic algorithm based on guesses. Note that this only happens ;; if the user does not want us to automatically recompile files ;; automatically (unless declaration-found (if (ada-xref-find-in-modified-ali identlist) (set 'declaration-found t) - ;; no more idea to find the declaration. Give up + ;; No more idea to find the declaration. Give up (progn (kill-buffer ali-buffer) (error (concat "No declaration of " (ada-name-of identlist) @@ -1911,7 +1909,7 @@ is using." (save-excursion - ;; Do the grep in all the directories. We do multiple shell + ;; Do the grep in all the directories. We do multiple shell ;; commands instead of one in case there is no .ali file in one ;; of the directory and the shell stops because of that. @@ -2011,7 +2009,7 @@ is using." (file line column identlist &optional other-frame) "Select and display FILE, at LINE and COLUMN. If we do not end on the same identifier as IDENTLIST, find the closest -match. Kills the .ali buffer at the end. +match. Kills the .ali buffer at the end. If OTHER-FRAME is non-nil, creates a new frame to show the file." (let (declaration-buffer) @@ -2178,7 +2176,7 @@ This function typically is to be hooked into `ff-file-created-hooks'." (unless (buffer-file-name (car (buffer-list))) (set-buffer (cadr (buffer-list)))) - ;; Make sure we have a project file (for parameters to gnatstub). Note that + ;; Make sure we have a project file (for parameters to gnatstub). Note that ;; this might have already been done if we have been called from the hook, ;; but this is not an expensive call) (ada-require-project-file) @@ -2240,9 +2238,9 @@ find-file...." ;; Use gvd or ddd as the default debugger if it was found ;; On windows, do not use the --tty switch for GVD, since this is -;; not supported. Actually, we do not use this on Unix either, since otherwise -;; there is no console window left in GVD, and people have to use the -;; Emacs one. +;; not supported. Actually, we do not use this on Unix either, +;; since otherwise there is no console window left in GVD, +;; and people have to use the Emacs one. ;; This must be done before initializing the Ada menu. (if (ada-find-file-in-dir "gvd" exec-path) (set 'ada-prj-default-debugger "gvd ") diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index b51a304c531..c5dd091f291 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -121,7 +121,7 @@ Works with: arglist-cont-nonempty, arglist-close." ;; like "({". (when c-special-brace-lists (let ((special-list (c-looking-at-special-brace-list))) - (when special-list + (when (and special-list (< (car (car special-list)) (point))) (goto-char (+ (car (car special-list)) 2))))) (let ((savepos (point)) @@ -380,9 +380,7 @@ Works with: inher-cont, member-init-cont." (back-to-indentation) (let* ((eol (c-point 'eol)) (here (point)) - (char-after-ip (progn - (skip-chars-forward " \t") - (char-after)))) + (char-after-ip (char-after))) (if (cdr langelem) (goto-char (cdr langelem))) ;; This kludge is necessary to support both inher-cont and @@ -392,13 +390,12 @@ Works with: inher-cont, member-init-cont." (backward-char) (c-backward-syntactic-ws)) - (skip-chars-forward "^:" eol) - (if (eq char-after-ip ?,) - (skip-chars-forward " \t" eol) - (skip-chars-forward " \t:" eol)) - (if (or (eolp) - (looking-at c-comment-start-regexp)) - (c-forward-syntactic-ws here)) + (c-syntactic-re-search-forward ":" eol 'move) + (if (looking-at c-syntactic-eol) + (c-forward-syntactic-ws here) + (if (eq char-after-ip ?,) + (backward-char) + (skip-chars-forward " \t" eol))) (if (< (point) here) (vector (current-column))) ))) @@ -952,11 +949,17 @@ Works with: defun-close, defun-block-intro, block-close, brace-list-close, brace-list-intro, statement-block-intro and all in* symbols, e.g. inclass and inextern-lang." (save-excursion - (goto-char (cdr langelem)) - (back-to-indentation) - (if (eq (char-syntax (char-after)) ?\() - 0 - c-basic-offset))) + (+ (progn + (back-to-indentation) + (if (eq (char-syntax (char-after)) ?\() + c-basic-offset + 0)) + (progn + (goto-char (cdr langelem)) + (back-to-indentation) + (if (eq (char-syntax (char-after)) ?\() + 0 + c-basic-offset))))) (defun c-lineup-cpp-define (langelem) "Line up macro continuation lines according to the indentation of diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index a61369004e8..806fbade693 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -479,7 +479,11 @@ This function does various newline cleanups based on the value of ;; end up before it. (setq delete-temp-newline (cons (save-excursion - (c-backward-syntactic-ws) + (end-of-line 0) + (if (eq (char-before) ?\\) + ;; Ignore a line continuation. + (backward-char)) + (skip-chars-backward " \t") (copy-marker (point) t)) (point-marker)))) (unwind-protect @@ -1971,8 +1975,7 @@ If `c-tab-always-indent' is t, always just indent the current line. If nil, indent the current line only if point is at the left margin or in the line's indentation; otherwise insert some whitespace[*]. If other than nil or t, then some whitespace[*] is inserted only within -literals (comments and strings) and inside preprocessor directives, -but the line is always reindented. +literals (comments and strings), but the line is always reindented. If `c-syntactic-indentation' is t, indentation is done according to the syntactic context. A numeric argument, regardless of its value, diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index ad8b8a92bff..64f3a72f56f 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -48,7 +48,6 @@ ;; Silence the compiler. (cc-bytecomp-defvar c-enable-xemacs-performance-kludge-p) ; In cc-vars.el -(cc-bytecomp-defvar c-emacs-features) ; In cc-vars.el (cc-bytecomp-defun buffer-syntactic-context-depth) ; XEmacs (cc-bytecomp-defun region-active-p) ; XEmacs (cc-bytecomp-defvar zmacs-region-stays) ; XEmacs @@ -105,7 +104,7 @@ ;;; Variables also used at compile time. -(defconst c-version "5.30.8" +(defconst c-version "5.30.9" "CC Mode version number.") (defconst c-version-sym (intern c-version)) @@ -620,20 +619,36 @@ This function does not do any hidden buffer changes." (eq (char-before) ?\\))) (backward-char)))) +(eval-and-compile + (defvar c-langs-are-parametric nil)) + (defmacro c-major-mode-is (mode) "Return non-nil if the current CC Mode major mode is MODE. MODE is either a mode symbol or a list of mode symbols. This function does not do any hidden buffer changes." - (if (eq (car-safe mode) 'quote) - (let ((mode (eval mode))) - (if (listp mode) - `(memq c-buffer-is-cc-mode ',mode) - `(eq c-buffer-is-cc-mode ',mode))) - `(let ((mode ,mode)) - (if (listp mode) - (memq c-buffer-is-cc-mode mode) - (eq c-buffer-is-cc-mode mode))))) + + (if c-langs-are-parametric + ;; Inside a `c-lang-defconst'. + `(c-lang-major-mode-is ,mode) + + (if (eq (car-safe mode) 'quote) + (let ((mode (eval mode))) + (if (listp mode) + `(memq c-buffer-is-cc-mode ',mode) + `(eq c-buffer-is-cc-mode ',mode))) + + `(let ((mode ,mode)) + (if (listp mode) + (memq c-buffer-is-cc-mode mode) + (eq c-buffer-is-cc-mode mode)))))) + +(defmacro c-mode-is-new-awk-p () + ;; Is the current mode the "new" awk mode? It is important for + ;; (e.g.) the cc-engine functions do distinguish between the old and + ;; new awk-modes. + '(and (c-major-mode-is 'awk-mode) + (memq 'syntax-properties c-emacs-features))) (defmacro c-parse-sexp-lookup-properties () ;; Return the value of the variable that says whether the @@ -968,13 +983,6 @@ the value of the variable with that name. This function does not do any hidden buffer changes." (symbol-value (c-mode-symbol suffix))) -(defsubst c-mode-is-new-awk-p () - ;; Is the current mode the "new" awk mode? It is important for - ;; (e.g.) the cc-engine functions do distinguish between the old and - ;; new awk-modes. - (and (c-major-mode-is 'awk-mode) - (memq 'syntax-properties c-emacs-features))) - (defsubst c-got-face-at (pos faces) "Return non-nil if position POS in the current buffer has any of the faces in the list FACES. @@ -1057,11 +1065,155 @@ current language (taken from `c-buffer-is-cc-mode')." (put 'c-make-keywords-re 'lisp-indent-function 1) +;; Figure out what features this Emacs has + +(cc-bytecomp-defvar open-paren-in-column-0-is-defun-start) + +(defconst c-emacs-features + (let (list) + + (if (boundp 'infodock-version) + ;; I've no idea what this actually is, but it's legacy. /mast + (setq list (cons 'infodock list))) + + ;; XEmacs 19 and beyond use 8-bit modify-syntax-entry flags. + ;; Emacs 19 uses a 1-bit flag. We will have to set up our + ;; syntax tables differently to handle this. + (let ((table (copy-syntax-table)) + entry) + (modify-syntax-entry ?a ". 12345678" table) + (cond + ;; XEmacs 19, and beyond Emacs 19.34 + ((arrayp table) + (setq entry (aref table ?a)) + ;; In Emacs, table entries are cons cells + (if (consp entry) (setq entry (car entry)))) + ;; XEmacs 20 + ((fboundp 'get-char-table) (setq entry (get-char-table ?a table))) + ;; before and including Emacs 19.34 + ((and (fboundp 'char-table-p) + (char-table-p table)) + (setq entry (car (char-table-range table [?a])))) + ;; incompatible + (t (error "CC Mode is incompatible with this version of Emacs"))) + (setq list (cons (if (= (logand (lsh entry -16) 255) 255) + '8-bit + '1-bit) + list))) + + (let ((buf (generate-new-buffer " test")) + parse-sexp-lookup-properties + parse-sexp-ignore-comments + lookup-syntax-properties) + (save-excursion + (set-buffer buf) + (set-syntax-table (make-syntax-table)) + + ;; For some reason we have to set some of these after the + ;; buffer has been made current. (Specifically, + ;; `parse-sexp-ignore-comments' in Emacs 21.) + (setq parse-sexp-lookup-properties t + parse-sexp-ignore-comments t + lookup-syntax-properties t) + + ;; Find out if the `syntax-table' text property works. + (modify-syntax-entry ?< ".") + (modify-syntax-entry ?> ".") + (insert "<()>") + (c-mark-<-as-paren 1) + (c-mark->-as-paren 4) + (goto-char 1) + (c-forward-sexp) + (if (= (point) 5) + (setq list (cons 'syntax-properties list))) + + ;; Find out if generic comment delimiters work. + (c-safe + (modify-syntax-entry ?x "!") + (if (string-match "\\s!" "x") + (setq list (cons 'gen-comment-delim list)))) + + ;; Find out if generic string delimiters work. + (c-safe + (modify-syntax-entry ?x "|") + (if (string-match "\\s|" "x") + (setq list (cons 'gen-string-delim list)))) + + ;; See if POSIX char classes work. + (when (and (string-match "[[:alpha:]]" "a") + ;; All versions of Emacs 21 so far haven't fixed + ;; char classes in `skip-chars-forward' and + ;; `skip-chars-backward'. + (progn + (delete-region (point-min) (point-max)) + (insert "foo123") + (skip-chars-backward "[:alnum:]") + (bobp)) + (= (skip-chars-forward "[:alpha:]") 3)) + (setq list (cons 'posix-char-classes list))) + + ;; See if `open-paren-in-column-0-is-defun-start' exists and + ;; isn't buggy. + (when (boundp 'open-paren-in-column-0-is-defun-start) + (let ((open-paren-in-column-0-is-defun-start nil) + (parse-sexp-ignore-comments t)) + (delete-region (point-min) (point-max)) + (set-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\' "\"") + (cond + ;; XEmacs. Afaik this is currently an Emacs-only + ;; feature, but it's good to be prepared. + ((memq '8-bit list) + (modify-syntax-entry ?/ ". 1456") + (modify-syntax-entry ?* ". 23")) + ;; Emacs + ((memq '1-bit list) + (modify-syntax-entry ?/ ". 124b") + (modify-syntax-entry ?* ". 23"))) + (modify-syntax-entry ?\n "> b") + (insert "/* '\n () */") + (backward-sexp) + (if (bobp) + (setq list (cons 'col-0-paren list))))) + + (set-buffer-modified-p nil)) + (kill-buffer buf)) + + ;; See if `parse-partial-sexp' returns the eighth element. + (when (c-safe (>= (length (save-excursion (parse-partial-sexp 1 1))) 10)) + (setq list (cons 'pps-extended-state list))) + + ;;(message "c-emacs-features: %S" list) + list) + "A list of certain features in the (X)Emacs you are using. +There are many flavors of Emacs out there, each with different +features supporting those needed by CC Mode. The following values +might be present: + +'8-bit 8 bit syntax entry flags (XEmacs style). +'1-bit 1 bit syntax entry flags (Emacs style). +'syntax-properties It works to override the syntax for specific characters + in the buffer with the 'syntax-table property. +'gen-comment-delim Generic comment delimiters work + (i.e. the syntax class `!'). +'gen-string-delim Generic string delimiters work + (i.e. the syntax class `|'). +'pps-extended-state `parse-partial-sexp' returns a list with at least 10 + elements, i.e. it contains the position of the + start of the last comment or string. +'posix-char-classes The regexp engine understands POSIX character classes. +'col-0-paren It's possible to turn off the ad-hoc rule that a paren + in column zero is the start of a defun. +'infodock This is Infodock (based on XEmacs). + +'8-bit and '1-bit are mutually exclusive.") + + ;;; Some helper constants. -;; If the regexp engine supports POSIX char classes (e.g. Emacs 21) -;; then we can use them to handle extended charsets correctly. -(if (string-match "[[:alpha:]]" "a") ; Can't use c-emacs-features here. +;; If the regexp engine supports POSIX char classes then we can use +;; them to handle extended charsets correctly. +(if (memq 'posix-char-classes c-emacs-features) (progn (defconst c-alpha "[:alpha:]") (defconst c-alnum "[:alnum:]") @@ -1127,8 +1279,8 @@ system." (error "The mode name symbol `%s' must end with \"-mode\"" mode)) (put mode 'c-mode-prefix (match-string 1 (symbol-name mode))) (unless (get base-mode 'c-mode-prefix) - (error "Unknown base mode `%s'" base-mode) - (put mode 'c-fallback-mode base-mode))) + (error "Unknown base mode `%s'" base-mode)) + (put mode 'c-fallback-mode base-mode)) (defvar c-lang-constants (make-vector 151 0)) ;; This obarray is a cache to keep track of the language constants @@ -1144,7 +1296,6 @@ system." ;; various other symbols, but those don't have any variable bindings. (defvar c-lang-const-expansion nil) -(defvar c-langs-are-parametric nil) (defsubst c-get-current-file () ;; Return the base name of the current file. @@ -1585,6 +1736,22 @@ This macro does not do any hidden buffer changes." c-lang-constants))) +(defun c-lang-major-mode-is (mode) + ;; `c-major-mode-is' expands to a call to this function inside + ;; `c-lang-defconst'. Here we also match the mode(s) against any + ;; fallback modes for the one in `c-buffer-is-cc-mode', so that + ;; e.g. (c-major-mode-is 'c++-mode) is true in a derived language + ;; that has c++-mode as base mode. + (unless (listp mode) + (setq mode (list mode))) + (let (match (buf-mode c-buffer-is-cc-mode)) + (while (if (memq buf-mode mode) + (progn + (setq match t) + nil) + (setq buf-mode (get buf-mode 'c-fallback-mode)))) + match)) + (cc-provide 'cc-defs) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index 2e907589304..ea36064412f 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1270,7 +1270,7 @@ This function does not do any hidden buffer changes." (when (and (= beg end) (get-text-property beg 'c-in-sws) - (not (bobp)) + (> beg (point-min)) (get-text-property (1- beg) 'c-in-sws)) ;; Ensure that an `c-in-sws' range gets broken. Note that it isn't ;; safe to keep a range that was continuous before the change. E.g: @@ -1906,7 +1906,7 @@ This function does not do any hidden buffer changes." (if last-pos ;; Prepare to loop, but record the open paren only if it's ;; outside a macro or within the same macro as point, and - ;; if it is a "real" open paren and not some character + ;; if it is a legitimate open paren and not some character ;; that got an open paren syntax-table property. (progn (setq pos last-pos) @@ -1914,7 +1914,11 @@ This function does not do any hidden buffer changes." (save-excursion (goto-char last-pos) (not (c-beginning-of-macro)))) - (= (char-syntax (char-before last-pos)) ?\()) + ;; Check for known types of parens that we want + ;; to record. The syntax table is not to be + ;; trusted here since the caller might be using + ;; e.g. `c++-template-syntax-table'. + (memq (char-before last-pos) '(?{ ?\( ?\[))) (setq c-state-cache (cons (1- last-pos) c-state-cache)))) (if (setq last-pos (c-up-list-forward pos)) @@ -2124,7 +2128,7 @@ This function does not do any hidden buffer changes." (when (c-major-mode-is 'pike-mode) ;; Handle the `<operator> syntax in Pike. (let ((pos (point))) - (skip-chars-backward "!%&*+\\-/<=>^|~[]()") + (skip-chars-backward "-!%&*+/<=>^|~[]()") (and (if (< (skip-chars-backward "`") 0) t (goto-char pos) @@ -2144,7 +2148,7 @@ This function does not do any hidden buffer changes." (and (c-major-mode-is 'pike-mode) ;; Handle the `<operator> syntax in Pike. (let ((pos (point))) - (if (and (< (skip-chars-backward "!%&*+\\-/<=>^|~[]()") 0) + (if (and (< (skip-chars-backward "-!%&*+/<=>^|~[]()") 0) (< (skip-chars-backward "`") 0) (looking-at c-symbol-key) (>= (match-end 0) pos)) @@ -2384,8 +2388,11 @@ outside any comment, macro or string literal, or else the content of that region is taken as syntactically significant text. If PAREN-LEVEL is non-nil, an additional restriction is added to -ignore matches in nested paren sexps, and the search will also not go -outside the current paren sexp. +ignore matches in nested paren sexps. The search will also not go +outside the current list sexp, which has the effect that if the point +should be moved to BOUND when no match is found \(i.e. NOERROR is +neither nil nor t), then it will be at the closing paren if the end of +the current list sexp is encountered first. If NOT-INSIDE-TOKEN is non-nil, matches in the middle of tokens are ignored. Things like multicharacter operators and special symbols @@ -2401,11 +2408,15 @@ subexpression is never tested before the starting position, so it might be a good idea to include \\=\\= as a match alternative in it. Optimization note: Matches might be missed if the \"look behind\" -subexpression should match the end of nonwhite syntactic whitespace, +subexpression can match the end of nonwhite syntactic whitespace, i.e. the end of comments or cpp directives. This since the function -skips over such things before resuming the search. It's also not safe -to assume that the \"look behind\" subexpression never can match -syntactic whitespace." +skips over such things before resuming the search. It's on the other +hand not safe to assume that the \"look behind\" subexpression never +matches syntactic whitespace. + +Bug: Unbalanced parens inside cpp directives are currently not handled +correctly \(i.e. they don't get ignored as they should) when +PAREN-LEVEL is set." (or bound (setq bound (point-max))) (if paren-level (setq paren-level -1)) @@ -2413,53 +2424,55 @@ syntactic whitespace." ;;(message "c-syntactic-re-search-forward %s %s %S" (point) bound regexp) (let ((start (point)) - (pos (point)) + tmp + ;; Start position for the last search. + search-pos + ;; The `parse-partial-sexp' state between the start position + ;; and the point. + state + ;; The current position after the last state update. The next + ;; `parse-partial-sexp' continues from here. + (state-pos (point)) + ;; The position at which to check the state and the state + ;; there. This is separate from `state-pos' since we might + ;; need to back up before doing the next search round. + check-pos check-state + ;; Last position known to end a token. (last-token-end-pos (point-min)) - match-pos found state check-pos check-state tmp) + ;; Set when a valid match is found. + found) (condition-case err (while (and - (re-search-forward regexp bound noerror) + (progn + (setq search-pos (point)) + (re-search-forward regexp bound noerror)) (progn - (setq match-pos (point) - state (parse-partial-sexp - pos (match-beginning 0) paren-level nil state) - pos (point)) + (setq state (parse-partial-sexp + state-pos (match-beginning 0) paren-level nil state) + state-pos (point)) (if (setq check-pos (and lookbehind-submatch + (or (not paren-level) + (>= (car state) 0)) (match-end lookbehind-submatch))) (setq check-state (parse-partial-sexp - pos check-pos paren-level nil state)) - (setq check-pos pos + state-pos check-pos paren-level nil state)) + (setq check-pos state-pos check-state state)) - ;; If we got a look behind subexpression and get an - ;; insignificant match in something that isn't + ;; NOTE: If we got a look behind subexpression and get + ;; an insignificant match in something that isn't ;; syntactic whitespace (i.e. strings or in nested ;; parentheses), then we can never skip more than a - ;; single character from the match position before - ;; continuing the search. That since the look behind - ;; subexpression might match the end of the - ;; insignificant region. + ;; single character from the match start position + ;; (i.e. `state-pos' here) before continuing the + ;; search. That since the look behind subexpression + ;; might match the end of the insignificant region in + ;; the next search. (cond - ((setq tmp (elt check-state 3)) - ;; Match inside a string. - (if (or lookbehind-submatch - (not (integerp tmp))) - (goto-char (min (1+ pos) bound)) - ;; Skip to the end of the string before continuing. - (let ((ender (make-string 1 tmp)) (continue t)) - (while (if (search-forward ender bound noerror) - (progn - (setq state (parse-partial-sexp - pos (point) nil nil state) - pos (point)) - (elt state 3)) - (setq continue nil))) - continue))) - ((elt check-state 7) ;; Match inside a line comment. Skip to eol. Use ;; `re-search-forward' instead of `skip-chars-forward' to get @@ -2472,6 +2485,7 @@ syntactic whitespace." ((and (not (elt check-state 5)) (eq (char-before check-pos) ?/) + (not (c-get-char-property (1- check-pos) 'syntax-table)) (memq (char-after check-pos) '(?/ ?*))) ;; Match in the middle of the opener of a block or line ;; comment. @@ -2479,20 +2493,57 @@ syntactic whitespace." (re-search-forward "[\n\r]" bound noerror) (search-forward "*/" bound noerror))) - ((and not-inside-token - (or (< check-pos last-token-end-pos) - (< check-pos - (save-excursion - (goto-char check-pos) - (save-match-data - (c-end-of-current-token last-token-end-pos)) - (setq last-token-end-pos (point)))))) - ;; Match inside a token. - (cond ((<= (point) bound) - (goto-char (min (1+ pos) bound)) - t) - (noerror nil) - (t (signal 'search-failed "end of token")))) + ;; The last `parse-partial-sexp' above might have + ;; stopped short of the real check position if the end + ;; of the current sexp was encountered in paren-level + ;; mode. The checks above are always false in that + ;; case, and since they can do better skipping in + ;; lookbehind-submatch mode, we do them before + ;; checking the paren level. + + ((and paren-level + (/= (setq tmp (car check-state)) 0)) + ;; Check the paren level first since we're short of the + ;; syntactic checking position if the end of the + ;; current sexp was encountered by `parse-partial-sexp'. + (if (> tmp 0) + + ;; Inside a nested paren sexp. + (if lookbehind-submatch + ;; See the NOTE above. + (progn (goto-char state-pos) t) + ;; Skip out of the paren quickly. + (setq state (parse-partial-sexp state-pos bound 0 nil state) + state-pos (point))) + + ;; Have exited the current paren sexp. + (if noerror + (progn + ;; The last `parse-partial-sexp' call above + ;; has left us just after the closing paren + ;; in this case, so we can modify the bound + ;; to leave the point at the right position + ;; upon return. + (setq bound (1- (point))) + nil) + (signal 'search-failed (list regexp))))) + + ((setq tmp (elt check-state 3)) + ;; Match inside a string. + (if (or lookbehind-submatch + (not (integerp tmp))) + ;; See the NOTE above. + (progn (goto-char state-pos) t) + ;; Skip to the end of the string before continuing. + (let ((ender (make-string 1 tmp)) (continue t)) + (while (if (search-forward ender bound noerror) + (progn + (setq state (parse-partial-sexp + state-pos (point) nil nil state) + state-pos (point)) + (elt state 3)) + (setq continue nil))) + continue))) ((save-excursion (save-match-data @@ -2501,48 +2552,52 @@ syntactic whitespace." (c-end-of-macro) (cond ((<= (point) bound) t) (noerror nil) - (t (signal 'search-failed "end of macro")))) + (t (signal 'search-failed (list regexp))))) - ((and paren-level - (/= (setq tmp (car check-state)) 0)) - (if (> tmp 0) - ;; Match inside a nested paren sexp. - (if lookbehind-submatch - (goto-char (min (1+ pos) bound)) - ;; Skip out of the paren quickly. - (setq state (parse-partial-sexp pos bound 0 nil state) - pos (point))) - ;; Have exited the current paren sexp. The - ;; `parse-partial-sexp' above has left us just after the - ;; closing paren in this case. Just make - ;; `re-search-forward' above fail in the appropriate way; - ;; we'll adjust the leave off point below if necessary. - (setq bound (point)))) + ((and not-inside-token + (or (< check-pos last-token-end-pos) + (< check-pos + (save-excursion + (goto-char check-pos) + (save-match-data + (c-end-of-current-token last-token-end-pos)) + (setq last-token-end-pos (point)))))) + ;; Inside a token. + (if lookbehind-submatch + ;; See the NOTE above. + (goto-char state-pos) + (goto-char (min last-token-end-pos bound)))) (t ;; A real match. (setq found t) - nil))))) + nil))) + + ;; Should loop to search again, but take care to avoid + ;; looping on the same spot. + (or (/= search-pos (point)) + (if (= (point) bound) + (if noerror + nil + (signal 'search-failed (list regexp))) + (forward-char) + t)))) (error (goto-char start) (signal (car err) (cdr err)))) - ;;(message "c-syntactic-re-search-forward done %s" (or match-pos (point))) + ;;(message "c-syntactic-re-search-forward done %s" (or (match-end 0) (point))) (if found (progn - (goto-char match-pos) - match-pos) + (goto-char (match-end 0)) + (match-end 0)) ;; Search failed. Set point as appropriate. - (cond ((eq noerror t) - (goto-char start)) - (paren-level - (if (eq (car (parse-partial-sexp pos bound -1 nil state)) -1) - (backward-char))) - (t - (goto-char bound))) + (if (eq noerror t) + (goto-char start) + (goto-char bound)) nil))) (defun c-syntactic-skip-backward (skip-chars &optional limit) @@ -4030,12 +4085,13 @@ This function does not do any hidden buffer changes." (defun c-forward-type () ;; Move forward over a type spec if at the beginning of one, ;; stopping at the next following token. Return t if it's a known - ;; type that can't be a name, 'known if it's an otherwise known type - ;; (according to `*-font-lock-extra-types'), 'prefix if it's a known - ;; prefix of a type, 'found if it's a type that matches one in - ;; `c-found-types', 'maybe if it's an identfier that might be a - ;; type, or nil if it can't be a type (the point isn't moved then). - ;; The point is assumed to be at the beginning of a token. + ;; type that can't be a name or other expression, 'known if it's an + ;; otherwise known type (according to `*-font-lock-extra-types'), + ;; 'prefix if it's a known prefix of a type, 'found if it's a type + ;; that matches one in `c-found-types', 'maybe if it's an identfier + ;; that might be a type, or nil if it can't be a type (the point + ;; isn't moved then). The point is assumed to be at the beginning + ;; of a token. ;; ;; Note that this function doesn't skip past the brace definition ;; that might be considered part of the type, e.g. @@ -4199,11 +4255,14 @@ This function does not do any hidden buffer changes." ;; don't let the existence of the operator itself promote two ;; uncertain types to a certain one. (cond ((eq res t)) - ((or (eq res 'known) (memq res2 '(t known))) + ((eq res2 t) (c-add-type id-start id-end) (when c-record-type-identifiers (c-record-type-id id-range)) (setq res t)) + ((eq res 'known)) + ((eq res2 'known) + (setq res 'known)) ((eq res 'found)) ((eq res2 'found) (setq res 'found)) @@ -4526,7 +4585,8 @@ brace." ;; `c-beginning-of-statement-1' stops at a block start, but we ;; want to continue if the block doesn't begin a top level - ;; construct, i.e. if it isn't preceded by ';', '}', ':', or bob. + ;; construct, i.e. if it isn't preceded by ';', '}', ':', bob, + ;; or an open paren. (let ((beg (point)) tentative-move) (while (and ;; Must check with c-opt-method-key in ObjC mode. @@ -4536,6 +4596,9 @@ brace." (progn (c-backward-syntactic-ws lim) (not (memq (char-before) '(?\; ?} ?: nil)))) + (save-excursion + (backward-char) + (not (looking-at "\\s("))) ;; Check that we don't move from the first thing in a ;; macro to its header. (not (eq (setq tentative-move @@ -4972,33 +5035,44 @@ brace." (condition-case () (save-excursion (let ((beg (point)) - end type) + inner-beg end type) (c-forward-syntactic-ws) (if (eq (char-after) ?\() (progn (forward-char 1) (c-forward-syntactic-ws) + (setq inner-beg (point)) (setq type (assq (char-after) c-special-brace-lists))) (if (setq type (assq (char-after) c-special-brace-lists)) (progn + (setq inner-beg (point)) (c-backward-syntactic-ws) (forward-char -1) (setq beg (if (eq (char-after) ?\() (point) nil))))) (if (and beg type) - (if (and (c-safe (goto-char beg) - (c-forward-sexp 1) - (setq end (point)) - (= (char-before) ?\))) - (c-safe (goto-char beg) - (forward-char 1) + (if (and (c-safe + (goto-char beg) + (c-forward-sexp 1) + (setq end (point)) + (= (char-before) ?\))) + (c-safe + (goto-char inner-beg) + (if (looking-at "\\s(") + ;; Check balancing of the inner paren + ;; below. + (progn (c-forward-sexp 1) - ;; Kludges needed to handle inner - ;; chars both with and without - ;; paren syntax. - (or (/= (char-syntax (char-before)) ?\)) - (= (char-before) (cdr type))))) + t) + ;; If the inner char isn't a paren then + ;; we can't check balancing, so just + ;; check the char before the outer + ;; closing paren. + (goto-char end) + (backward-char) + (c-backward-syntactic-ws) + (= (char-before) (cdr type))))) (if (or (/= (char-syntax (char-before)) ?\)) (= (progn (c-forward-syntactic-ws) @@ -6272,7 +6346,7 @@ This function does not do any hidden buffer changes." (goto-char containing-sexp) (setq placeholder (c-point 'boi)) (if (and (c-safe (backward-up-list 1) t) - (> (point) placeholder)) + (>= (point) placeholder)) (progn (forward-char) (skip-chars-forward " \t")) @@ -6313,7 +6387,7 @@ This function does not do any hidden buffer changes." (goto-char containing-sexp) (setq placeholder (c-point 'boi)) (when (and (c-safe (backward-up-list 1) t) - (> (point) placeholder)) + (>= (point) placeholder)) (forward-char) (skip-chars-forward " \t") (setq placeholder (point))) @@ -6354,7 +6428,7 @@ This function does not do any hidden buffer changes." (goto-char containing-sexp) (setq placeholder (c-point 'boi)) (if (and (c-safe (backward-up-list 1) t) - (> (point) placeholder)) + (>= (point) placeholder)) (progn (forward-char) (skip-chars-forward " \t")) @@ -6830,6 +6904,10 @@ This function does not do any hidden buffer changes." ((vectorp offset) offset) ((null offset) nil) ((listp offset) + (if (eq (car offset) 'quote) + (error +"Setting in c-offsets-alist element \"(%s . '%s)\" was mistakenly quoted" + symbol (cadr offset))) (let (done) (while (and (not done) offset) (setq done (c-evaluate-offset (car offset) langelem symbol) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 27c604b3f33..c5bbfaf86dd 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -574,33 +574,65 @@ casts and declarations are fontified. Used on level 2 and higher." ;; Fontify leading identifiers in fully qualified names like ;; "foo::bar" in languages that supports such things. ,@(when (c-lang-const c-opt-identifier-concat-key) - `((,(byte-compile - ;; Must use a function here since we match longer - ;; than we want to move before doing a new search. - ;; This is not necessary for XEmacs >= 20 since it - ;; restarts the search from the end of the first - ;; highlighted submatch (something that causes - ;; problems in other places). - `(lambda (limit) - (while (re-search-forward - ,(concat "\\(\\<" ; 1 - "\\(" (c-lang-const c-symbol-key) "\\)" ; 2 - "[ \t\n\r\f\v]*" - (c-lang-const c-opt-identifier-concat-key) - "[ \t\n\r\f\v]*" - "\\)" - "\\(" - (c-lang-const c-opt-after-id-concat-key) - "\\)") - limit t) - (unless (progn - (goto-char (match-beginning 0)) - (c-skip-comments-and-strings limit)) - (or (get-text-property (match-beginning 2) 'face) - (c-put-font-lock-face (match-beginning 2) - (match-end 2) - c-reference-face-name)) - (goto-char (match-end 1))))))))) + (if (c-major-mode-is 'java-mode) + ;; Java needs special treatment since "." is used both to + ;; qualify names and in normal indexing. Here we look for + ;; capital characters at the beginning of an identifier to + ;; recognize the class. "*" is also recognized to cover + ;; wildcard import declarations. All preceding dot separated + ;; identifiers are taken as package names and therefore + ;; fontified as references. + `(,(c-make-font-lock-search-function + ;; Search for class identifiers preceded by ".". The + ;; anchored matcher takes it from there. + (concat (c-lang-const c-opt-identifier-concat-key) + "[ \t\n\r\f\v]*" + (concat "\\(" + "[" c-upper "][" (c-lang-const c-symbol-chars) "]*" + "\\|" + "\\*" + "\\)")) + `((let (id-end) + (goto-char (1+ (match-beginning 0))) + (while (and (eq (char-before) ?.) + (progn + (backward-char) + (c-backward-syntactic-ws) + (setq id-end (point)) + (< (skip-chars-backward + ,(c-lang-const c-symbol-chars)) 0)) + (not (get-text-property (point) 'face))) + (c-put-font-lock-face (point) id-end c-reference-face-name) + (c-backward-syntactic-ws))) + nil + (goto-char (match-end 0))))) + + `((,(byte-compile + ;; Must use a function here since we match longer than we + ;; want to move before doing a new search. This is not + ;; necessary for XEmacs >= 20 since it restarts the search + ;; from the end of the first highlighted submatch (something + ;; that causes problems in other places). + `(lambda (limit) + (while (re-search-forward + ,(concat "\\(\\<" ; 1 + "\\(" (c-lang-const c-symbol-key) "\\)" ; 2 + "[ \t\n\r\f\v]*" + (c-lang-const c-opt-identifier-concat-key) + "[ \t\n\r\f\v]*" + "\\)" + "\\(" + (c-lang-const c-opt-after-id-concat-key) + "\\)") + limit t) + (unless (progn + (goto-char (match-beginning 0)) + (c-skip-comments-and-strings limit)) + (or (get-text-property (match-beginning 2) 'face) + (c-put-font-lock-face (match-beginning 2) + (match-end 2) + c-reference-face-name)) + (goto-char (match-end 1)))))))))) ;; Fontify the special declarations in Objective-C. ,@(when (c-major-mode-is 'objc-mode) @@ -787,17 +819,19 @@ casts and declarations are fontified. Used on level 2 and higher." (<= (point) limit) ;; Search syntactically to the end of the declarator (";", - ;; ",", ")", ">" (for <> arglists), eob etc) or to the - ;; beginning of an initializer or function prototype ("=" - ;; or "\\s\("). + ;; ",", a closen paren, eob etc) or to the beginning of an + ;; initializer or function prototype ("=" or "\\s\("). + ;; Note that the open paren will match array specs in + ;; square brackets, and we treat them as initializers too. (c-syntactic-re-search-forward - "[\];,\{\}\[\)>]\\|\\'\\|\\(=\\|\\(\\s\(\\)\\)" limit t t)) + "[;,]\\|\\s)\\|\\'\\|\\(=\\|\\s(\\)" limit t t)) (setq next-pos (match-beginning 0) - id-face (if (match-beginning 2) + id-face (if (eq (char-after next-pos) ?\() 'font-lock-function-name-face 'font-lock-variable-name-face) - got-init (match-beginning 1)) + got-init (and (match-beginning 1) + (char-after (match-beginning 1)))) (if types ;; Register and fontify the identifer as a type. @@ -828,9 +862,17 @@ casts and declarations are fontified. Used on level 2 and higher." (goto-char limit))) (got-init - ;; Skip an initializer expression. - (if (c-syntactic-re-search-forward "[;,]" limit 'move t) - (backward-char))) + ;; Skip an initializer expression. If we're at a '=' + ;; then accept a brace list directly after it to cope + ;; with array initializers. Otherwise stop at braces + ;; to avoid going past full function and class blocks. + (and (if (and (eq got-init ?=) + (= (c-forward-token-2) 0) + (looking-at "{")) + (c-safe (c-forward-sexp) t) + t) + (c-syntactic-re-search-forward "[;,{]" limit 'move t) + (backward-char))) (t (c-forward-syntactic-ws limit))) diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 19555b37527..6aeb70ba4e3 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -374,6 +374,12 @@ identifiers, or nil in languages that don't have such things. Does not contain a \\| operator at the top level." t nil c++ "::" + ;; Java has "." to concatenate identifiers but it's also used for + ;; normal indexing. There's special code in the Java font lock + ;; rules to fontify qualified identifiers based on the standard + ;; naming conventions. We still define "." here to make + ;; `c-forward-name' move over as long names as possible which is + ;; necessary to e.g. handle throws clauses correctly. java "\\." idl "::" pike "\\(::\\|\\.\\)") diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 13ffd310fce..1a26e54bf06 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -355,6 +355,8 @@ when used elsewhere." (completing-read prompt c-style-alist nil t (cons c-indentation-style 0) 'c-set-style-history)))))) + (or (stringp stylename) + (error "Argument to c-set-style was not a string")) (c-initialize-builtin-style) (let ((vars (c-get-style-variables stylename nil))) (unless dont-override diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index f21531c2f22..2ed23f8ef86 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -271,12 +271,12 @@ nil." (defcustom c-tab-always-indent t "*Controls the operation of the TAB key. -If t, hitting TAB always just indents the current line. If nil, -hitting TAB indents the current line if point is at the left margin or -in the line's indentation, otherwise it insert a `real' tab character -\(see note\). If the symbol `other', then tab is inserted only within -literals -- defined as comments and strings -- and inside preprocessor -directives, but the line is always reindented. +If t, hitting TAB always just indents the current line. If nil, hitting +TAB indents the current line if point is at the left margin or in the +line's indentation, otherwise it inserts a `real' tab character \(see +note\). If some other value (not nil or t), then tab is inserted only +within literals \(comments and strings), but the line is always +reindented. Note: The value of `indent-tabs-mode' will determine whether a real tab character will be inserted, or the equivalent number of spaces. @@ -1546,140 +1546,6 @@ Set from `c-comment-prefix-regexp' at mode initialization.") (make-variable-buffer-local 'c-current-comment-prefix) -;; Figure out what features this Emacs has - -(cc-bytecomp-defvar open-paren-in-column-0-is-defun-start) - -(defconst c-emacs-features - (let (list) - - (if (boundp 'infodock-version) - ;; I've no idea what this actually is, but it's legacy. /mast - (setq list (cons 'infodock list))) - - ;; XEmacs 19 and beyond use 8-bit modify-syntax-entry flags. - ;; Emacs 19 uses a 1-bit flag. We will have to set up our - ;; syntax tables differently to handle this. - (let ((table (copy-syntax-table)) - entry) - (modify-syntax-entry ?a ". 12345678" table) - (cond - ;; XEmacs 19, and beyond Emacs 19.34 - ((arrayp table) - (setq entry (aref table ?a)) - ;; In Emacs, table entries are cons cells - (if (consp entry) (setq entry (car entry)))) - ;; XEmacs 20 - ((fboundp 'get-char-table) (setq entry (get-char-table ?a table))) - ;; before and including Emacs 19.34 - ((and (fboundp 'char-table-p) - (char-table-p table)) - (setq entry (car (char-table-range table [?a])))) - ;; incompatible - (t (error "CC Mode is incompatible with this version of Emacs"))) - (setq list (cons (if (= (logand (lsh entry -16) 255) 255) - '8-bit - '1-bit) - list))) - - (let ((buf (generate-new-buffer " test")) - parse-sexp-lookup-properties - parse-sexp-ignore-comments - lookup-syntax-properties) - (save-excursion - (set-buffer buf) - (set-syntax-table (make-syntax-table)) - - ;; For some reason we have to set some of these after the - ;; buffer has been made current. (Specifically, - ;; `parse-sexp-ignore-comments' in Emacs 21.) - (setq parse-sexp-lookup-properties t - parse-sexp-ignore-comments t - lookup-syntax-properties t) - - ;; Find out if the `syntax-table' text property works. - (modify-syntax-entry ?< ".") - (modify-syntax-entry ?> ".") - (insert "<()>") - (c-mark-<-as-paren 1) - (c-mark->-as-paren 4) - (goto-char 1) - (c-forward-sexp) - (if (= (point) 5) - (setq list (cons 'syntax-properties list))) - - ;; Find out if generic comment delimiters work. - (c-safe - (modify-syntax-entry ?x "!") - (if (string-match "\\s!" "x") - (setq list (cons 'gen-comment-delim list)))) - - ;; Find out if generic string delimiters work. - (c-safe - (modify-syntax-entry ?x "|") - (if (string-match "\\s|" "x") - (setq list (cons 'gen-string-delim list)))) - - ;; See if `open-paren-in-column-0-is-defun-start' exists and - ;; isn't buggy. - (when (boundp 'open-paren-in-column-0-is-defun-start) - (let ((open-paren-in-column-0-is-defun-start nil) - (parse-sexp-ignore-comments t)) - (set-syntax-table (make-syntax-table)) - (modify-syntax-entry ?\' "\"") - (cond - ;; XEmacs. Afaik this is currently an Emacs-only - ;; feature, but it's good to be prepared. - ((memq '8-bit list) - (modify-syntax-entry ?/ ". 1456") - (modify-syntax-entry ?* ". 23")) - ;; Emacs - ((memq '1-bit list) - (modify-syntax-entry ?/ ". 124b") - (modify-syntax-entry ?* ". 23"))) - (modify-syntax-entry ?\n "> b") - (insert "/* '\n () */") - (backward-sexp) - (if (bobp) - (setq list (cons 'col-0-paren list)))) - (kill-buffer buf)) - - (set-buffer-modified-p nil)) - (kill-buffer buf)) - - ;; See if `parse-partial-sexp' returns the eighth element. - (when (c-safe (>= (length (save-excursion (parse-partial-sexp 1 1))) 10)) - (setq list (cons 'pps-extended-state list))) - - ;; See if POSIX char classes work. - (when (string-match "[[:alpha:]]" "a") - (setq list (cons 'posix-char-classes list))) - - list) - "A list of certain features in the (X)Emacs you are using. -There are many flavors of Emacs out there, each with different -features supporting those needed by CC Mode. The following values -might be present: - -'8-bit 8 bit syntax entry flags (XEmacs style). -'1-bit 1 bit syntax entry flags (Emacs style). -'syntax-properties It works to override the syntax for specific characters - in the buffer with the 'syntax-table property. -'gen-comment-delim Generic comment delimiters work - (i.e. the syntax class `!'). -'gen-string-delim Generic string delimiters work - (i.e. the syntax class `|'). -'pps-extended-state `parse-partial-sexp' returns a list with at least 10 - elements, i.e. it contains the position of the - start of the last comment or string. -'posix-char-classes The regexp engine understands POSIX character classes. -'col-0-paren It's possible to turn off the ad-hoc rule that a paren - in column zero is the start of a defun. -'infodock This is Infodock (based on XEmacs). - -'8-bit and '1-bit are mutually exclusive.") - - (cc-provide 'cc-vars) ;;; arch-tag: d62e9a55-c9fe-409b-b5b6-050b6aa202c9 diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index 033ce883e5f..ea174233289 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -458,9 +458,9 @@ starting the compilation process.") :version "21.4") (defface compilation-info-face - '((((class color) (min-colors 16) (background light)) + '((((class color) (min-colors 16) (background light)) (:foreground "Green3" :weight bold)) - (((class color) (min-colors 16) (background dark)) + (((class color) (min-colors 16) (background dark)) (:foreground "Green" :weight bold)) (((class color)) (:foreground "green" :weight bold)) (t (:weight bold))) @@ -579,12 +579,17 @@ Faces `compilation-error-face', `compilation-warning-face', (and end-line (setq end-line (match-string-no-properties end-line)) (setq end-line (string-to-number end-line))) - (and col - (setq col (match-string-no-properties col)) - (setq col (- (string-to-number col) compilation-first-column))) - (if (and end-col (setq end-col (match-string-no-properties end-col))) - (setq end-col (- (string-to-number end-col) compilation-first-column -1)) - (if end-line (setq end-col -1))) + (if col + (if (functionp col) + (setq col (funcall col)) + (and + (setq col (match-string-no-properties col)) + (setq col (- (string-to-number col) compilation-first-column))))) + (if (and end-col (functionp end-col)) + (setq end-col (funcall end-col)) + (if (and end-col (setq end-col (match-string-no-properties end-col))) + (setq end-col (- (string-to-number end-col) compilation-first-column -1)) + (if end-line (setq end-col -1)))) (if (consp type) ; not a static type, check what it is. (setq type (or (and (car type) (match-end (car type)) 1) (and (cdr type) (match-end (cdr type)) 0) @@ -726,9 +731,9 @@ FILE should be (ABSOLUTE-FILENAME) or (RELATIVE-FILENAME . DIRNAME) or nil." ,@(when end-line `((,end-line compilation-line-face nil t))) - ,@(when col + ,@(when (integerp col) `((,col compilation-column-face nil t))) - ,@(when end-col + ,@(when (integerp end-col) `((,end-col compilation-column-face nil t))) ,@(nthcdr 6 item) @@ -789,7 +794,10 @@ If this is run in a Compilation mode buffer, re-use the arguments from the original use. Otherwise, recompile using `compile-command'." (interactive) (save-some-buffers (not compilation-ask-about-save) nil) - (let ((default-directory (or compilation-directory default-directory))) + (let ((default-directory + (or (and (not (eq major-mode (nth 1 compilation-arguments))) + compilation-directory) + default-directory))) (apply 'compilation-start (or compilation-arguments `(,(eval compile-command)))))) @@ -816,8 +824,7 @@ Otherwise, construct a buffer name from MODE-NAME." (funcall name-function mode-name)) (compilation-buffer-name-function (funcall compilation-buffer-name-function mode-name)) - ((and (eq major-mode 'compilation-mode) - (equal mode-name (nth 2 compilation-arguments))) + ((eq major-mode (nth 1 compilation-arguments)) (buffer-name)) (t (concat "*" (downcase mode-name) "*")))) @@ -1101,7 +1108,9 @@ from a different message." move point to the error message line and type \\[compile-goto-error]. To kill the compilation, type \\[kill-compilation]. -Runs `compilation-mode-hook' with `run-hooks' (which see)." +Runs `compilation-mode-hook' with `run-hooks' (which see). + +\\{compilation-mode-map}" (interactive) (kill-all-local-variables) (use-local-map compilation-mode-map) @@ -1520,7 +1529,8 @@ If nil, don't scroll the compilation output window." (defun compilation-goto-locus (msg mk end-mk) "Jump to an error corresponding to MSG at MK. -All arguments are markers. If END-MK is non nil, mark is set there." +All arguments are markers. If END-MK is non-nil, mark is set there +and overlay is highlighted between MK and END-MK." (if (eq (window-buffer (selected-window)) (marker-buffer msg)) ;; If the compilation buffer window is selected, @@ -1536,7 +1546,7 @@ All arguments are markers. If END-MK is non nil, mark is set there." (widen) (goto-char mk)) (if end-mk - (push-mark end-mk nil t) + (push-mark end-mk t) (if mark-active (setq mark-active))) ;; If hideshow got in the way of ;; seeing the right place, open permanently. @@ -1557,26 +1567,32 @@ All arguments are markers. If END-MK is non nil, mark is set there." compilation-highlight-regexp))) (compilation-set-window-height w) - (when (and highlight-regexp - (not (and end-mk transient-mark-mode))) + (when highlight-regexp (unless compilation-highlight-overlay (setq compilation-highlight-overlay (make-overlay (point-min) (point-min))) - (overlay-put compilation-highlight-overlay 'face 'region)) + (overlay-put compilation-highlight-overlay 'face 'next-error)) (with-current-buffer (marker-buffer mk) (save-excursion - (end-of-line) + (if end-mk (goto-char end-mk) (end-of-line)) (let ((end (point))) - (beginning-of-line) + (if mk (goto-char mk) (beginning-of-line)) (if (and (stringp highlight-regexp) (re-search-forward highlight-regexp end t)) (progn (goto-char (match-beginning 0)) - (move-overlay compilation-highlight-overlay (match-beginning 0) (match-end 0))) - (move-overlay compilation-highlight-overlay (point) end)) - (sit-for 0.5) - (delete-overlay compilation-highlight-overlay))))))) - + (move-overlay compilation-highlight-overlay + (match-beginning 0) (match-end 0) + (current-buffer))) + (move-overlay compilation-highlight-overlay + (point) end (current-buffer))) + (if (numberp next-error-highlight) + (sit-for next-error-highlight)) + (if (not (eq next-error-highlight t)) + (delete-overlay compilation-highlight-overlay)))))) + (when (and (eq next-error-highlight 'fringe-arrow)) + (set (make-local-variable 'overlay-arrow-position) + (copy-marker (line-beginning-position)))))) (defun compilation-find-file (marker filename dir &rest formats) "Find a buffer for file FILENAME. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 184077f6a3a..ddbd2ce6f35 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -772,26 +772,6 @@ Assumes the tags table is the current buffer." (all-completions string (tags-completion-table) predicate) (try-completion string (tags-completion-table) predicate)))) -;; Return a default tag to search for, based on the text at point. -(defun find-tag-default () - (save-excursion - (while (looking-at "\\sw\\|\\s_") - (forward-char 1)) - (if (or (re-search-backward "\\sw\\|\\s_" - (save-excursion (beginning-of-line) (point)) - t) - (re-search-forward "\\(\\sw\\|\\s_\\)+" - (save-excursion (end-of-line) (point)) - t)) - (progn (goto-char (match-end 0)) - (buffer-substring-no-properties - (point) - (progn (forward-sexp -1) - (while (looking-at "\\s'") - (forward-char 1)) - (point)))) - nil))) - ;; Read a tag name from the minibuffer with defaulting and completion. (defun find-tag-tag (string) (let* ((completion-ignore-case (if (memq tags-case-fold-search '(t nil)) @@ -1453,53 +1433,58 @@ where they were found." (tags-with-face 'highlight (princ buffer-file-name)) (princ "':\n\n")) (goto-char (point-min)) - (while (re-search-forward string nil t) - (beginning-of-line) + (let ((point-max (/ (float (point-max)) 100.0))) + (while (re-search-forward string nil t) + (message "Making tags apropos buffer for `%s'...%d%%" + string + (/ (point) point-max)) + (beginning-of-line) - (let* (;; Get the local value in the tags table - ;; buffer before switching buffers. - (goto-func goto-tag-location-function) - (tag-info (save-excursion (funcall snarf-tag-function))) - (tag (if (eq t (car tag-info)) nil (car tag-info))) - (file-path (save-excursion (if tag (file-of-tag) - (save-excursion (next-line 1) - (file-of-tag))))) - (file-label (if tag (file-of-tag t) - (save-excursion (next-line 1) - (file-of-tag t)))) - (pt (with-current-buffer standard-output (point)))) - (if tag - (progn - (princ (format "[%s]: " file-label)) - (princ tag) - (when (= (aref tag 0) ?\() (princ " ...)")) - (with-current-buffer standard-output - (make-text-button pt (point) - 'tag-info tag-info - 'file-path file-path - 'goto-func goto-func - 'action (lambda (button) - (let ((tag-info (button-get button 'tag-info)) - (goto-func (button-get button 'goto-func))) - (tag-find-file-of-tag (button-get button 'file-path)) - (widen) - (funcall goto-func tag-info))) - 'face 'tags-tag-face - 'type 'button))) - (princ (format "- %s" file-label)) - (with-current-buffer standard-output - (make-text-button pt (point) - 'file-path file-path - 'action (lambda (button) - (tag-find-file-of-tag (button-get button 'file-path)) - ;; Get the local value in the tags table - ;; buffer before switching buffers. - (goto-char (point-min))) - 'face 'tags-tag-face - 'type 'button)) - )) - (terpri) - (forward-line 1)) + (let* ( ;; Get the local value in the tags table + ;; buffer before switching buffers. + (goto-func goto-tag-location-function) + (tag-info (save-excursion (funcall snarf-tag-function))) + (tag (if (eq t (car tag-info)) nil (car tag-info))) + (file-path (save-excursion (if tag (file-of-tag) + (save-excursion (next-line 1) + (file-of-tag))))) + (file-label (if tag (file-of-tag t) + (save-excursion (next-line 1) + (file-of-tag t)))) + (pt (with-current-buffer standard-output (point)))) + (if tag + (progn + (princ (format "[%s]: " file-label)) + (princ tag) + (when (= (aref tag 0) ?\() (princ " ...)")) + (with-current-buffer standard-output + (make-text-button pt (point) + 'tag-info tag-info + 'file-path file-path + 'goto-func goto-func + 'action (lambda (button) + (let ((tag-info (button-get button 'tag-info)) + (goto-func (button-get button 'goto-func))) + (tag-find-file-of-tag (button-get button 'file-path)) + (widen) + (funcall goto-func tag-info))) + 'face 'tags-tag-face + 'type 'button))) + (princ (format "- %s" file-label)) + (with-current-buffer standard-output + (make-text-button pt (point) + 'file-path file-path + 'action (lambda (button) + (tag-find-file-of-tag (button-get button 'file-path)) + ;; Get the local value in the tags table + ;; buffer before switching buffers. + (goto-char (point-min))) + 'face 'tags-tag-face + 'type 'button)) + )) + (terpri) + (forward-line 1)) + (message nil)) (when tags-apropos-verbose (princ "\n"))) (defun etags-tags-table-files () diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 5b678f26171..9d48fd37569 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -64,6 +64,21 @@ will be parsed and highlighted as soon as you try to move to them." :version "21.4" :group 'grep) +(defcustom grep-highlight-matches t + "*Non-nil to use special markers to highlight grep matches. + +Some grep programs are able to surround matches with special +markers in grep output. Such markers can be used to highlight +matches in grep mode. + +This option sets the environment variable GREP_COLOR to specify +markers for highlighting and GREP_OPTIONS to add the --color +option in front of any explicit grep options before starting +the grep." + :type 'boolean + :version "21.4" + :group 'grep) + (defcustom grep-scroll-output nil "*Non-nil to scroll the *grep* buffer window as output appears. @@ -230,6 +245,23 @@ Notice that using \\[next-error] or \\[compile-goto-error] modifies '(("^\\(.+?\\)[:( \t]+\ \\([0-9]+\\)\\([.:]?\\)\\([0-9]+\\)?\ \\(?:-\\(?:\\([0-9]+\\)\\3\\)?\\.?\\([0-9]+\\)?\\)?[:) \t]" 1 (2 . 5) (4 . 6)) + ("^\\(.+?\\)[:(]+\\([0-9]+\\)\\([:)]\\).*?\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" + 1 2 + ((lambda () + (setq compilation-error-screen-columns nil) + (- (match-beginning 5) (match-end 3) 8)) + . + (lambda () (- (match-end 5) (match-end 3) 8))) + nil nil + (4 (list 'face nil 'invisible t 'intangible t)) + (5 (list 'face compilation-column-face)) + (6 (list 'face nil 'invisible t 'intangible t)) + ;; highlight other matches on the same line + ("\\(\033\\[01;41m\\)\\(.*?\\)\\(\033\\[00m\\)" + nil nil + (1 (list 'face nil 'invisible t 'intangible t)) + (2 (list 'face compilation-column-face) t) + (3 (list 'face nil 'invisible t 'intangible t)))) ("^Binary file \\(.+\\) matches$" 1 nil nil 1)) "Regexp used to match grep hits. See `compilation-error-regexp-alist'.") @@ -300,6 +332,10 @@ This variable's value takes effect when `grep-compute-defaults' is called.") (defun grep-process-setup () "Setup compilation variables and buffer for `grep'. Set up `compilation-exit-message-function' and run `grep-setup-hook'." + (when grep-highlight-matches + ;; Modify `process-environment' locally bound in `compilation-start' + (setenv "GREP_OPTIONS" (concat (getenv "GREP_OPTIONS") " --color=always")) + (setenv "GREP_COLOR" "01;41")) (set (make-local-variable 'compilation-exit-message-function) (lambda (status code msg) (if (eq status 'exit) @@ -384,9 +420,7 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." (let ((tag-default (funcall (or find-tag-default-function (get major-mode 'find-tag-default-function) - ;; We use grep-tag-default instead of - ;; find-tag-default, to avoid loading etags. - 'grep-tag-default))) + 'find-tag-default))) (sh-arg-re "\\(\\(?:\"\\(?:[^\"]\\|\\\\\"\\)+\"\\|'[^']+'\\|[^\"' \t\n]\\)+\\)") (grep-default (or (car grep-history) grep-command))) ;; Replace the thing matching for with that around cursor. @@ -457,25 +491,6 @@ temporarily highlight in visited source lines." (set (make-local-variable 'compilation-error-regexp-alist) grep-regexp-alist)) -;; This is a copy of find-tag-default from etags.el. -;;;###autoload -(defun grep-tag-default () - (save-excursion - (while (looking-at "\\sw\\|\\s_") - (forward-char 1)) - (when (or (re-search-backward "\\sw\\|\\s_" - (save-excursion (beginning-of-line) (point)) - t) - (re-search-forward "\\(\\sw\\|\\s_\\)+" - (save-excursion (end-of-line) (point)) - t)) - (goto-char (match-end 0)) - (buffer-substring (point) - (progn (forward-sexp -1) - (while (looking-at "\\s'") - (forward-char 1)) - (point)))))) - ;;;###autoload (defun grep-find (command-args) "Run grep via find, with user-specified args COMMAND-ARGS. diff --git a/lisp/progmodes/meta-mode.el b/lisp/progmodes/meta-mode.el index 7bf9e935710..ecf8da2e509 100644 --- a/lisp/progmodes/meta-mode.el +++ b/lisp/progmodes/meta-mode.el @@ -32,7 +32,7 @@ ;; a major mode including an approriate syntax table, keymap, and a ;; mode-specific pull-down menu. It also provides a sophisticated set ;; of font-lock patterns, a fancy indentation function adapted from -;; AUC-TeX's latex.el, and some basic mode-specific editing functions +;; AUCTeX's latex.el, and some basic mode-specific editing functions ;; such as functions to move to the beginning or end of the enclosing ;; environment, or to mark, re-indent, or comment-out environments. ;; On the other hand, it doesn't yet provide any functionality for diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index f47ca3a73d4..cef86f8f90e 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -353,6 +353,11 @@ the car and cdr are the same symbol.") (defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file)) "The shell being programmed. This is set by \\[sh-set-shell].") +(defvar sh-mode-abbrev-table nil) + +(define-abbrev-table 'sh-mode-abbrev-table ()) + + ;; I turned off this feature because it doesn't permit typing commands ;; in the usual way without help. ;;(defvar sh-abbrevs @@ -1483,7 +1488,7 @@ Calls the value of `sh-set-shell-hook' if set." (setq require-final-newline tem))) (setq comment-start-skip "#+[\t ]*" -;;; local-abbrev-table (sh-feature sh-abbrevs) + local-abbrev-table sh-mode-abbrev-table mode-line-process (format "[%s]" sh-shell) sh-shell-variables nil sh-shell-variables-initialized nil diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el index 87df0769314..845c995371d 100644 --- a/lisp/progmodes/which-func.el +++ b/lisp/progmodes/which-func.el @@ -186,7 +186,7 @@ It creates the Imenu index for the buffer, if necessary." (which-func-update-1 (selected-window))) (defun which-func-update-1 (window) - "Update the Which-Function mode display for window WINDOW." + "Update the Which Function mode display for window WINDOW." (with-selected-window window (when which-func-mode (condition-case info diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index 1d13358f53d..fe9d7350398 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -213,53 +213,6 @@ Any other value is treated as nil." (const bdf-font-except-latin) (const :tag "nil" nil)) :group 'ps-print-font) - -(eval-and-compile - ;; For Emacs 20.2 and the earlier version. - (if (and (boundp 'mule-version) - (not (string< (symbol-value 'mule-version) "4.0"))) - ;; mule package is loaded - (progn - (defalias 'ps-mule-next-point '1+) - (defalias 'ps-mule-chars-in-string 'length) - (defalias 'ps-mule-string-char 'aref) - (defsubst ps-mule-next-index (str i) (1+ i))) - ;; mule package isn't loaded or mule version lesser than 4.0 - (defun ps-mule-next-point (arg) - (save-excursion (goto-char arg) (forward-char 1) (point))) - (defun ps-mule-chars-in-string (string) - (/ (length string) - (charset-bytes (char-charset (string-to-char string))))) - (defun ps-mule-string-char (string idx) - (string-to-char (substring string idx))) - (defun ps-mule-next-index (string i) - (+ i (charset-bytes (char-charset (string-to-char string))))) - ) - ;; For Emacs 20.4 and the earlier version. - (if (and (boundp 'mule-version) - (string< (symbol-value 'mule-version) "5.0")) - ;; mule package is loaded and mule version is lesser than 5.0 - (progn - (defun encode-composition-rule (rule) - (if (= (car rule) 4) (setcar rule 10)) - (if (= (cdr rule) 4) (setcdr rule 10)) - (+ (* (car rule) 12) (cdr rule))) - (defun find-composition (pos &rest ignore) - (let ((ch (char-after pos))) - (and ch (eq (char-charset ch) 'composition) - (let ((components (decompose-composite-char ch 'vector t))) - (list pos (ps-mule-next-point pos) components - (integerp (aref components 1)) nil - (char-width ch))))))) - ;; mule package isn't loaded - (or (fboundp 'encode-composition-rule) - (defun encode-composition-rule (rule) - 130)) - (or (fboundp 'find-composition) - (defun find-composition (pos &rest ignore) - nil)) - )) - (defvar ps-mule-font-info-database nil "Alist of charsets with the corresponding font information. @@ -273,7 +226,7 @@ CHARSET is a charset (symbol) for this font family, FONT-TYPE is a font type: normal, bold, italic, or bold-italic. -FONT-SRC is a font source: builtin, ps-bdf, vflib, or nil. +FONT-SRC is a font source: builtin, bdf, vflib, or nil. If FONT-SRC is builtin, FONT-NAME is a built-in PostScript font name. @@ -847,7 +800,7 @@ the sequence." run-width))) ;; We assume that all characters in this range have the same width. (setq char-width (* char-width (charset-width ps-mule-current-charset))) - (let ((run-width (* (chars-in-region from to) char-width))) + (let ((run-width (* (abs (- from to)) char-width))) (if (> run-width ps-width-remaining) (cons (min to (save-excursion diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 72ba4c24eed..78a558baebe 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -10,12 +10,12 @@ ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) ;; Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, print, PostScript -;; Time-stamp: <2004/03/10 18:57:00 vinicius> -;; Version: 6.6.4 +;; Time-stamp: <2004/07/21 23:12:05 vinicius> +;; Version: 6.6.5 ;; X-URL: http://www.cpqd.com.br/~vinicius/emacs/ -(defconst ps-print-version "6.6.4" - "ps-print.el, v 6.6.4 <2004/03/10 vinicius> +(defconst ps-print-version "6.6.5" + "ps-print.el, v 6.6.5 <2004/07/21 vinicius> Vinicius's last change version -- this file may have been edited as part of Emacs without changes to the version number. When reporting bugs, please also @@ -1353,6 +1353,9 @@ Please send all bug fixes and enhancements to ;; Acknowledgments ;; --------------- ;; +;; Thanks to Michael Piotrowski <mxp@dynalabs.de> for improving the DSC +;; compliance of the generated PostScript. +;; ;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion ;; for black/white PostScript printers. ;; @@ -1424,7 +1427,7 @@ Please send all bug fixes and enhancements to ;; initial port to Emacs 19. His code is no longer part of ps-print, but his ;; work is still appreciated. ;; -;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org, for +;; Thanks to Remi Houdaille and Michel Train <michel@metasoft.fdn.org> for ;; adding underline support. Their code also is no longer part of ps-print, ;; but their efforts are not forgotten. ;; @@ -4162,6 +4165,7 @@ If EXTENSION is any other symbol, it is ignored." (defun ps-message-log-max () (and (not (string= (buffer-name) "*Messages*")) + (boundp 'message-log-max) message-log-max)) @@ -4210,7 +4214,7 @@ If EXTENSION is any other symbol, it is ignored." (defvar ps-printing-region nil - "Variable used to indicate if the region that ps-print is printing. + "Variable used to indicate the region that ps-print is printing. It is a cons, the car of which is the line number where the region begins, and its cdr is the total number of lines in the buffer. Formatting functions can use this information to print the original line number (and not the number of @@ -4729,12 +4733,16 @@ page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th (let (str) (while content (setq str (cons (cond + ;; string ((stringp (car content)) (car content)) + ;; function symbol ((and (symbolp (car content)) (fboundp (car content))) (concat "(" (funcall (car content)) ")")) + ;; variable symbol ((and (symbolp (car content)) (boundp (car content))) (concat "(" (symbol-value (car content)) ")")) + ;; otherwise, empty string (t "")) str) @@ -5424,9 +5432,9 @@ XSTART YSTART are the relative position for the first page in a sheet.") ps-adobe-tag "%%Title: " (buffer-name) ; Take job name from name of ; first buffer printed - "\n%%Creator: " (user-full-name) - " (using ps-print v" ps-print-version - ")\n%%CreationDate: " (format-time-string "%T %b %d %Y") + "\n%%Creator: ps-print v" ps-print-version + "\n%%For: " (user-full-name) + "\n%%CreationDate: " (format-time-string "%T %b %d %Y") "\n%%Orientation: " (if ps-landscape-mode "Landscape" "Portrait") "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font " @@ -5434,8 +5442,11 @@ XSTART YSTART are the relative position for the first page in a sheet.") (ps-remove-duplicates (append (ps-fonts 'ps-font-for-text) (list (ps-font 'ps-font-for-header 'normal) - (ps-font 'ps-font-for-header 'bold)))) + (ps-font 'ps-font-for-header 'bold) + (ps-font 'ps-font-for-footer 'normal) + (ps-font 'ps-font-for-footer 'bold)))) "\n%%+ font ") + "\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0" "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions) (format " %d" (round (ps-page-dimensions-get-width dimensions))) (format " %d" (round (ps-page-dimensions-get-height dimensions))) @@ -5455,11 +5466,11 @@ XSTART YSTART are the relative position for the first page in a sheet.") ps-error-handler-alist)) 1)) ; send to paper ps-print-prologue-0 - "\n%%BeginProcSet: UserDefinedPrologue\n\n") + "\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n") (ps-insert-string ps-user-defined-prologue) - (ps-output "\n%%EndProcSet\n\n") + (ps-output "\n%%EndResource\n\n") (ps-output-boolean "LandscapeMode " (or ps-landscape-mode @@ -5565,26 +5576,37 @@ XSTART YSTART are the relative position for the first page in a sheet.") (setq ps-background-all-pages (nreverse ps-background-all-pages) ps-background-pages (nreverse ps-background-pages)) - (ps-output "\n" ps-print-prologue-1) - - (ps-output "\n/printGlobalBackground{\n") + (ps-output "\n" ps-print-prologue-1 + "\n/printGlobalBackground{\n") (mapcar 'ps-output ps-background-all-pages) - (ps-output "}def\n/printLocalBackground{\n}def\n") - - ;; Header/line number fonts - (ps-output (format "/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont - ps-header-title-font-size-internal - (ps-font 'ps-font-for-header 'bold)) - (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont - ps-header-font-size-internal - (ps-font 'ps-font-for-header 'normal)) - (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont - (ps-get-font-size 'ps-line-number-font-size) - ps-line-number-font) - (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont - ps-footer-font-size-internal - (ps-font 'ps-font-for-footer 'normal)) - "\n\n% ---- These lines must be kept together because... + (ps-output + "}def\n/printLocalBackground{\n}def\n" + "\n%%EndProlog\n\n%%BeginSetup\n" + "\n%%IncludeResource: font Times-Roman" + "\n%%IncludeResource: font Times-Italic" + "\n%%IncludeResource: font " + (mapconcat 'identity + (ps-remove-duplicates + (append (ps-fonts 'ps-font-for-text) + (list (ps-font 'ps-font-for-header 'normal) + (ps-font 'ps-font-for-header 'bold) + (ps-font 'ps-font-for-footer 'normal) + (ps-font 'ps-font-for-footer 'bold)))) + "\n%%IncludeResource: font ") + ;; Header/line number fonts + (format "\n/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont + ps-header-title-font-size-internal + (ps-font 'ps-font-for-header 'bold)) + (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont + ps-header-font-size-internal + (ps-font 'ps-font-for-header 'normal)) + (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont + (ps-get-font-size 'ps-line-number-font-size) + ps-line-number-font) + (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont + ps-footer-font-size-internal + (ps-font 'ps-font-for-footer 'normal)) + "\n\n% ---- These lines must be kept together because... /h0 F /HeaderTitleLineHeight FontHeight def @@ -5614,7 +5636,6 @@ XSTART YSTART are the relative position for the first page in a sheet.") (ps-output (format "/SpaceWidthRatio %f def\n" (/ (ps-lookup 'space-width) (ps-lookup 'size))))) - (ps-output "\n%%EndProlog\n\n%%BeginSetup\n") (unless (eq ps-spool-config 'lpr-switches) (ps-output "\n%%BeginFeature: *Duplex " (ps-boolean-capitalized ps-spool-duplex) diff --git a/lisp/replace.el b/lisp/replace.el index f81c6f53914..47437659923 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -94,7 +94,8 @@ wants to replace FROM with TO." query-replace-from-history-variable nil t)))) (if (and (zerop (length from)) lastto lastfrom) - (cons lastfrom lastto) + (cons lastfrom + (query-replace-compile-replacement lastto regexp-flag)) ;; Warn if user types \n or \t, but don't reject the input. (and regexp-flag (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from) @@ -107,15 +108,12 @@ wants to replace FROM with TO." (sit-for 2))) from)))) -(defun query-replace-read-to (from string regexp-flag) - "Query and return the `from' argument of a query-replace operation." - (let ((to (save-excursion - (read-from-minibuffer - (format "%s %s with: " string (query-replace-descr from)) - nil nil nil - query-replace-to-history-variable from t)))) - (when (and regexp-flag - (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)) +(defun query-replace-compile-replacement (to regexp-flag) + "Maybe convert a regexp replacement TO to Lisp. +Returns a list suitable for `perform-replace' if necessary, +the original string if not." + (if (and regexp-flag + (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to)) (let (pos list char) (while (progn @@ -142,14 +140,25 @@ wants to replace FROM with TO." (cdr pos)))) (setq to (substring to end))))) (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\\\[,#]" to))) - (setq to (nreverse (delete "" (cons to list))))) - (replace-match-string-symbols to) - (setq to (cons 'replace-eval-replacement - (if (> (length to) 1) - (cons 'concat to) - (car to))))) + (setq to (nreverse (delete "" (cons to list)))) + (replace-match-string-symbols to) + (cons 'replace-eval-replacement + (if (cdr to) + (cons 'concat to) + (car to)))) to)) + +(defun query-replace-read-to (from string regexp-flag) + "Query and return the `to' argument of a query-replace operation." + (query-replace-compile-replacement + (save-excursion + (read-from-minibuffer + (format "%s %s with: " string (query-replace-descr from)) + nil nil nil + query-replace-to-history-variable from t)) + regexp-flag)) + (defun query-replace-read-args (string regexp-flag &optional noerror) (unless noerror (barf-if-buffer-read-only)) @@ -732,6 +741,8 @@ Compatibility function for \\[next-error] invocations." #'previous-single-property-change #'next-single-property-change) "No more matches") + ;; In case the *Occur* buffer is visible in a nonselected window. + (set-window-point (get-buffer-window (current-buffer)) (point)) (occur-mode-goto-occurrence)) @@ -1009,9 +1020,11 @@ See also `multi-occur'." ;; concatenate them all together. (apply #'concat (nconc - (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ nlines)) keep-props)))) + (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ (abs nlines))) keep-props)))) (list out-line) - (occur-engine-add-prefix (cdr (occur-accumulate-lines (1+ nlines) keep-props)))))))) + (if (> nlines 0) + (occur-engine-add-prefix + (cdr (occur-accumulate-lines (1+ nlines) keep-props))))))))) ;; Actually insert the match display data (with-current-buffer out-buf (let ((beg (point)) diff --git a/lisp/select.el b/lisp/select.el index c095ea50c44..565ddd7d22e 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -3,7 +3,7 @@ ;; Maintainer: FSF ;; Keywords: internal -;; Copyright (c) 1993, 1994 Free Software Foundation, Inc. +;; Copyright (c) 1993, 1994, 2004 Free Software Foundation, Inc. ;; Based partially on earlier release by Lucid. ;; This file is part of GNU Emacs. @@ -35,7 +35,11 @@ The argument TYPE (default `PRIMARY') says which selection, and the argument DATA-TYPE (default `STRING') says how to convert the data. -TYPE may be `SECONDARY' or `CLIPBOARD', in addition to `PRIMARY'. +TYPE may be any symbol \(but nil stands for `PRIMARY'). However, +only a few symbols are commonly used. They conventionally have +all upper-case names. The most often used ones, in addition to +`PRIMARY', are `SECONDARY' and `CLIPBOARD'. + DATA-TYPE is usually `STRING', but can also be one of the symbols in `selection-converter-alist', which see." (let ((data (x-get-selection-internal (or type 'PRIMARY) @@ -57,9 +61,11 @@ in `selection-converter-alist', which see." (defun x-set-selection (type data) "Make an X Windows selection of type TYPE and value DATA. -The argument TYPE (default `PRIMARY') says which selection, -and DATA specifies the contents. DATA may be a string, -a symbol, an integer (or a cons of two integers or list of two integers). +The argument TYPE (nil means `PRIMARY') says which selection, and +DATA specifies the contents. TYPE must be a symbol. \(It can also +be a string, which stands for the symbol with that name, but this +is considered obsolete.) DATA may be a string, a symbol, an +integer (or a cons of two integers or list of two integers). The selection may also be a cons of two markers pointing to the same buffer, or an overlay. In these cases, the selection is considered to be the text @@ -69,8 +75,11 @@ can alter the effective value of the selection. The data may also be a vector of valid non-vector selection values. -Interactively, the text of the region is used as the selection value -if the prefix arg is set." +The return value is DATA. + +Interactively, this command sets the primary selection. Without +prefix argument, it reads the selection in the minibuffer. With +prefix argument, it uses the text of the region as the selection value ." (interactive (if (not current-prefix-arg) (list 'PRIMARY (read-string "Set text for pasting: ")) (list 'PRIMARY (buffer-substring (region-beginning) (region-end))))) diff --git a/lisp/simple.el b/lisp/simple.el index 9d61a390575..271a07ee531 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -65,7 +65,7 @@ (setq found buffer))) (setq list (cdr list))) (switch-to-buffer found))) - + ;;; next-error support framework (defvar next-error-last-buffer nil "The most recent next-error buffer. @@ -91,51 +91,50 @@ to navigate in it.") (or (and extra-test (funcall extra-test)) next-error-function))) -;; Return a next-error capable buffer according to the following rules: -;; 1. If the current buffer is a next-error capable buffer, return it. -;; 2. If one window on the selected frame displays such buffer, return it. -;; 3. If next-error-last-buffer is set to a live buffer, use that. -;; 4. Otherwise, look for a next-error capable buffer in a buffer list. -;; 5. Signal an error if there are none. (defun next-error-find-buffer (&optional other-buffer extra-test) - (if (and (not other-buffer) - (next-error-buffer-p (current-buffer) extra-test)) - ;; The current buffer is a next-error capable buffer. - (current-buffer) - (or - (let ((window-buffers - (delete-dups - (delq nil - (mapcar (lambda (w) - (and (next-error-buffer-p (window-buffer w) extra-test) - (window-buffer w))) - (window-list)))))) - (if other-buffer - (setq window-buffers (delq (current-buffer) window-buffers))) - (if (eq (length window-buffers) 1) - (car window-buffers))) - (if (and next-error-last-buffer (buffer-name next-error-last-buffer) - (next-error-buffer-p next-error-last-buffer extra-test) - (or (not other-buffer) (not (eq next-error-last-buffer - (current-buffer))))) - next-error-last-buffer - (let ((buffers (buffer-list))) - (while (and buffers (or (not (next-error-buffer-p (car buffers) extra-test)) - (and other-buffer - (eq (car buffers) (current-buffer))))) - (setq buffers (cdr buffers))) - (if buffers - (car buffers) - (or (and other-buffer - (next-error-buffer-p (current-buffer) extra-test) - ;; The current buffer is a next-error capable buffer. - (progn - (if other-buffer - (message "This is the only next-error capable buffer.")) - (current-buffer))) - (error "No next-error capable buffer found")))))))) - -(defun next-error (arg &optional reset) + "Return a next-error capable buffer." + (or + ;; 1. If one window on the selected frame displays such buffer, return it. + (let ((window-buffers + (delete-dups + (delq nil (mapcar (lambda (w) + (if (next-error-buffer-p + (window-buffer w) extra-test) + (window-buffer w))) + (window-list)))))) + (if other-buffer + (setq window-buffers (delq (current-buffer) window-buffers))) + (if (eq (length window-buffers) 1) + (car window-buffers))) + ;; 2. If next-error-last-buffer is set to a live buffer, use that. + (if (and next-error-last-buffer + (buffer-name next-error-last-buffer) + (next-error-buffer-p next-error-last-buffer extra-test) + (or (not other-buffer) + (not (eq next-error-last-buffer (current-buffer))))) + next-error-last-buffer) + ;; 3. If the current buffer is a next-error capable buffer, return it. + (if (and (not other-buffer) + (next-error-buffer-p (current-buffer) extra-test)) + (current-buffer)) + ;; 4. Look for a next-error capable buffer in a buffer list. + (let ((buffers (buffer-list))) + (while (and buffers + (or (not (next-error-buffer-p (car buffers) extra-test)) + (and other-buffer (eq (car buffers) (current-buffer))))) + (setq buffers (cdr buffers))) + (if buffers + (car buffers) + (or (and other-buffer + (next-error-buffer-p (current-buffer) extra-test) + ;; The current buffer is a next-error capable buffer. + (progn + (if other-buffer + (message "This is the only next-error capable buffer")) + (current-buffer))) + (error "No next-error capable buffer found")))))) + +(defun next-error (&optional arg reset) "Visit next next-error message and corresponding source code. If all the error messages parsed so far have been processed already, @@ -153,9 +152,10 @@ compilation, grep, or occur buffer. It can also operate on any buffer with output from the \\[compile], \\[grep] commands, or, more generally, on any buffer in Compilation mode or with Compilation Minor mode enabled, or any buffer in which -`next-error-function' is bound to an appropriate -function. To specify use of a particular buffer for error -messages, type \\[next-error] in that buffer. +`next-error-function' is bound to an appropriate function. +To specify use of a particular buffer for error messages, type +\\[next-error] in that buffer when it is the only one displayed +in the current frame. Once \\[next-error] has chosen the buffer for error messages, it stays with that buffer until you use it in some other buffer which @@ -175,7 +175,7 @@ See variables `compilation-parse-errors-function' and (define-key ctl-x-map "`" 'next-error) -(defun previous-error (n) +(defun previous-error (&optional n) "Visit previous next-error message and corresponding source code. Prefix arg N says how many error messages to move backwards (or @@ -183,9 +183,9 @@ forwards, if negative). This operates on the output from the \\[compile] and \\[grep] commands." (interactive "p") - (next-error (- n))) + (next-error (- (or n 1)))) -(defun first-error (n) +(defun first-error (&optional n) "Restart at the first error. Visit corresponding source code. With prefix arg N, visit the source code of the Nth error. @@ -193,25 +193,63 @@ This operates on the output from the \\[compile] command, for instance." (interactive "p") (next-error n t)) -(defun next-error-no-select (n) +(defun next-error-no-select (&optional n) "Move point to the next error in the next-error buffer and highlight match. Prefix arg N says how many error messages to move forwards (or backwards, if negative). Finds and highlights the source line like \\[next-error], but does not select the source buffer." (interactive "p") - (next-error n) + (let ((next-error-highlight next-error-highlight-no-select)) + (next-error n)) (pop-to-buffer next-error-last-buffer)) -(defun previous-error-no-select (n) +(defun previous-error-no-select (&optional n) "Move point to the previous error in the next-error buffer and highlight match. Prefix arg N says how many error messages to move backwards (or forwards, if negative). Finds and highlights the source line like \\[previous-error], but does not select the source buffer." (interactive "p") - (next-error-no-select (- n))) + (next-error-no-select (- (or n 1)))) + +(defgroup next-error nil + "next-error support framework." + :group 'compilation + :version "21.4") +(defface next-error + '((t (:inherit region))) + "Face used to highlight next error locus." + :group 'next-error + :version "21.4") + +(defcustom next-error-highlight 0.1 + "*Highlighting of locations in selected source buffers. +If number, highlight the locus in next-error face for given time in seconds. +If t, use persistent overlays fontified in next-error face. +If nil, don't highlight the locus in the source buffer. +If `fringe-arrow', indicate the locus by the fringe arrow." + :type '(choice (number :tag "Delay") + (const :tag "Persistent overlay" t) + (const :tag "No highlighting" nil) + (const :tag "Fringe arrow" 'fringe-arrow)) + :group 'next-error + :version "21.4") + +(defcustom next-error-highlight-no-select 0.1 + "*Highlighting of locations in non-selected source buffers. +If number, highlight the locus in next-error face for given time in seconds. +If t, use persistent overlays fontified in next-error face. +If nil, don't highlight the locus in the source buffer. +If `fringe-arrow', indicate the locus by the fringe arrow." + :type '(choice (number :tag "Delay") + (const :tag "Persistent overlay" t) + (const :tag "No highlighting" nil) + (const :tag "Fringe arrow" 'fringe-arrow)) + :group 'next-error + :version "21.4") + ;;; (defun fundamental-mode () @@ -1628,7 +1666,7 @@ and only used if a buffer is displayed." (defun shell-command-on-region (start end command &optional output-buffer replace - error-buffer) + error-buffer display-error-buffer) "Execute string COMMAND in inferior shell with region as input. Normally display output (if any) in temp buffer `*Shell Command Output*'; Prefix arg means replace the region with it. Return the exit code of @@ -1641,10 +1679,10 @@ is encoded in the same coding system that will be used to save the file, `buffer-file-coding-system'. If the output is going to replace the region, then it is decoded from that same coding system. -The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, -REPLACE, ERROR-BUFFER. Noninteractive callers can specify coding -systems by binding `coding-system-for-read' and -`coding-system-for-write'. +The noninteractive arguments are START, END, COMMAND, +OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER. +Noninteractive callers can specify coding systems by binding +`coding-system-for-read' and `coding-system-for-write'. If the command generates output, the output may be displayed in the echo area or in a buffer. @@ -1674,6 +1712,8 @@ around it. If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer or buffer name to which to direct the command's standard error output. If it is nil, error output is mingled with regular output. +If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there +were any errors. (This is always t, interactively.) In an interactive call, the variable `shell-command-default-error-buffer' specifies the value of ERROR-BUFFER." (interactive (let (string) @@ -1691,7 +1731,8 @@ specifies the value of ERROR-BUFFER." string current-prefix-arg current-prefix-arg - shell-command-default-error-buffer))) + shell-command-default-error-buffer + t))) (let ((error-file (if error-buffer (make-temp-file @@ -1800,7 +1841,8 @@ specifies the value of ERROR-BUFFER." (format-insert-file error-file nil) ;; Put point after the inserted errors. (goto-char (- (point-max) pos-from-end))) - (display-buffer (current-buffer)))) + (and display-error-buffer + (display-buffer (current-buffer))))) (delete-file error-file)) exit-status)) @@ -4304,6 +4346,12 @@ make the common parts less visible than normal, so that the rest of the differing parts is, by contrast, slightly highlighted." :group 'completion) +;; This is for packages that need to bind it to a non-default regexp +;; in order to make the first-differing character highlight work +;; to their liking +(defvar completion-root-regexp "^/" + "Regexp to use in `completion-setup-function' to find the root directory.") + (defun completion-setup-function () (let ((mainbuf (current-buffer)) (mbuf-contents (minibuffer-contents))) @@ -4313,6 +4361,13 @@ of the differing parts is, by contrast, slightly highlighted." (if minibuffer-completing-file-name (with-current-buffer mainbuf (setq default-directory (file-name-directory mbuf-contents)))) + ;; If partial-completion-mode is on, point might not be after the + ;; last character in the minibuffer. + ;; FIXME: This still doesn't work if the text to be completed + ;; starts with a `-'. + (when (and partial-completion-mode (not (eobp))) + (setq mbuf-contents + (substring mbuf-contents 0 (- (point) (point-max))))) (with-current-buffer standard-output (completion-list-mode) (make-local-variable 'completion-reference-buffer) @@ -4325,7 +4380,7 @@ of the differing parts is, by contrast, slightly highlighted." (with-current-buffer mainbuf (save-excursion (goto-char (point-max)) - (skip-chars-backward "^/") + (skip-chars-backward completion-root-regexp) (- (point) (minibuffer-prompt-end))))) ;; Otherwise, in minibuffer, the whole input is being completed. (if (minibufferp mainbuf) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index f8e9386585d..db16f2f78f3 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -92,7 +92,7 @@ ;; into sub-lists. A long flat list can be used instead if needed. ;; Other filters can be easily added. ;; -;; AUC-TEX users: The imenu tags for AUC-TEX mode doesn't work very +;; AUCTEX users: The imenu tags for AUCTEX mode doesn't work very ;; well. Use the imenu keywords from tex-mode.el for better results. ;; ;; This file requires the library package assoc (association lists) @@ -665,6 +665,9 @@ useful, such as version control." "*Regexp matching files we don't want displayed in a speedbar buffer. It is generated from the variable `completion-ignored-extensions'") +;; Compiler silencing trick. The real defvar comes later in this file. +(defvar speedbar-file-regexp) + ;; this is dangerous to customize, because the defaults will probably ;; change in the future. (defcustom speedbar-supported-extension-expressions @@ -689,8 +692,7 @@ file." :type '(repeat (regexp :tag "Extension Regexp")) :set (lambda (sym val) (setq speedbar-supported-extension-expressions val - speedbar-file-regexp (speedbar-extension-list-to-regex val))) - ) + speedbar-file-regexp (speedbar-extension-list-to-regex val)))) (defvar speedbar-file-regexp (speedbar-extension-list-to-regex speedbar-supported-extension-expressions) @@ -698,6 +700,15 @@ file." Created from `speedbar-supported-extension-expression' with the function `speedbar-extension-list-to-regex'") +(defcustom speedbar-scan-subdirs nil + "*Non-nil means speedbar will check if subdirs are empty. +That way you don't have to click on them to find out. But this +incurs extra I/O, hence it slows down directory display +proportionally to the number of subdirs." + :group 'speedbar + :type 'boolean + :version 21.4) + (defun speedbar-add-supported-extension (extension) "Add EXTENSION as a new supported extension for speedbar tagging. This should start with a `.' if it is not a complete file name, and @@ -1287,8 +1298,9 @@ in the selected file. (toggle-read-only 1) (speedbar-set-mode-line-format) (if speedbar-xemacsp - (set (make-local-variable 'mouse-motion-handler) - 'speedbar-track-mouse-xemacs) + (with-no-warnings + (set (make-local-variable 'mouse-motion-handler) + 'speedbar-track-mouse-xemacs)) (if speedbar-track-mouse-flag (set (make-local-variable 'track-mouse) t)) ;this could be messy. (setq auto-show-mode nil)) ;no auto-show for Emacs @@ -1337,7 +1349,8 @@ This gives visual indications of what is up. It EXPECTS the speedbar frame and window to be the currently active frame and window." (if (and (frame-live-p speedbar-frame) (or (not speedbar-xemacsp) - (specifier-instance has-modeline-p))) + (with-no-warnings + (specifier-instance has-modeline-p)))) (save-excursion (set-buffer speedbar-buffer) (let* ((w (or (speedbar-frame-width) 20)) @@ -1538,9 +1551,7 @@ Must be bound to event E." ;; This gets the cursor where the user can see it. (if (not (bolp)) (forward-char -1)) (sit-for 0) - (if (< emacs-major-version 20) - (mouse-major-mode-menu e) - (mouse-major-mode-menu e nil)))) + (mouse-major-mode-menu e nil))) (defun speedbar-hack-buffer-menu (e) "Control mouse 1 is buffer menu. @@ -2185,21 +2196,17 @@ the file-system." ;; find the directory, either in the cache, or build it. (or (cdr-safe (assoc directory speedbar-directory-contents-alist)) (let ((default-directory directory) - (dir (directory-files directory nil)) - (dirs nil) - (files nil)) - (while dir - (if (not - (or (string-match speedbar-file-unshown-regexp (car dir)) - (string-match speedbar-directory-unshown-regexp (car dir)))) - (if (file-directory-p (car dir)) - (setq dirs (cons (car dir) dirs)) - (setq files (cons (car dir) files)))) - (setq dir (cdr dir))) - (let ((nl (cons (nreverse dirs) (list (nreverse files))))) + (case-fold-search read-file-name-completion-ignore-case) + dirs files) + (dolist (file (directory-files directory nil)) + (or (string-match speedbar-file-unshown-regexp file) + (string-match speedbar-directory-unshown-regexp file) + (if (file-directory-p file) + (setq dirs (cons file dirs)) + (setq files (cons file files))))) + (let ((nl `(,(nreverse dirs) ,(nreverse files)))) (aput 'speedbar-directory-contents-alist directory nl) - nl)) - )) + nl)))) (defun speedbar-directory-buttons (directory index) "Insert a single button group at point for DIRECTORY. @@ -2343,34 +2350,40 @@ position to insert a new item, and that the new item will end with a CR." ;;; Build button lists ;; -(defun speedbar-insert-files-at-point (files level) +(defun speedbar-insert-files-at-point (files level directory) "Insert list of FILES starting at point, and indenting all files to LEVEL. Tag expandable items with a +, otherwise a ?. Don't highlight ? as we don't know how to manage them. The input parameter FILES is a cons cell of the form ( 'DIRLIST . 'FILELIST )." ;; Start inserting all the directories - (let ((dirs (car files))) - (while dirs - (speedbar-make-tag-line 'angle ?+ 'speedbar-dired (car dirs) - (car dirs) 'speedbar-dir-follow nil - 'speedbar-directory-face level) - (setq dirs (cdr dirs)))) - (let ((lst (car (cdr files))) - (case-fold-search t)) - (while lst - (let* ((known (string-match speedbar-file-regexp (car lst))) + (dolist (dir (car files)) + (if (if speedbar-scan-subdirs + (condition-case nil + (let ((l (speedbar-file-lists (concat directory dir)))) + (or (car l) (cadr l))) + (file-error)) + (file-readable-p (concat directory dir))) + (speedbar-make-tag-line 'angle ?+ 'speedbar-dired dir + dir 'speedbar-dir-follow nil + 'speedbar-directory-face level) + (speedbar-make-tag-line 'angle ? nil dir + dir 'speedbar-dir-follow nil + 'speedbar-directory-face level))) + (let ((case-fold-search read-file-name-completion-ignore-case)) + (dolist (file (cadr files)) + (let* ((known (and (file-readable-p (concat directory file)) + (string-match speedbar-file-regexp file))) (expchar (if known ?+ ??)) (fn (if known 'speedbar-tag-file nil))) (if (or speedbar-show-unknown-files (/= expchar ??)) - (speedbar-make-tag-line 'bracket expchar fn (car lst) - (car lst) 'speedbar-find-file nil - 'speedbar-file-face level))) - (setq lst (cdr lst))))) + (speedbar-make-tag-line 'bracket expchar fn file + file 'speedbar-find-file nil + 'speedbar-file-face level)))))) (defun speedbar-default-directory-list (directory index) "Insert files for DIRECTORY with level INDEX at point." (speedbar-insert-files-at-point - (speedbar-file-lists directory) index) + (speedbar-file-lists directory) index directory) (speedbar-reset-scanners) (if (= index 0) ;; If the shown files variable has extra directories, then @@ -2918,7 +2931,7 @@ updated." (newcf (if newcfd newcfd)) (lastb (current-buffer)) (sucf-recursive (boundp 'sucf-recursive)) - (case-fold-search t)) + (case-fold-search read-file-name-completion-ignore-case)) (if (and newcf ;; check here, that way we won't refresh to newcf until ;; its been written, thus saving ourselves some time @@ -4235,9 +4248,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image." (speedbar-convert-emacs21-imagespec-to-xemacs (quote ,imagespec))) 'buffer) (error nil)) - ,docstring)) - -))) + ,docstring))))) (defimage-speedbar speedbar-directory-plus ((:type xpm :file "sb-dir-plus.xpm" :ascent center)) @@ -4247,6 +4258,10 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image." ((:type xpm :file "sb-dir-minus.xpm" :ascent center)) "Image used for open directories with stuff in them.") +(defimage-speedbar speedbar-directory + ((:type xpm :file "sb-dir.xpm" :ascent center)) + "Image used for empty or unreadable directories.") + (defimage-speedbar speedbar-page-plus ((:type xpm :file "sb-pg-plus.xpm" :ascent center)) "Image used for closed files with stuff in them.") @@ -4290,6 +4305,7 @@ IMAGESPEC is the image data, and DOCSTRING is documentation for the image." (defvar speedbar-expand-image-button-alist '(("<+>" . speedbar-directory-plus) ("<->" . speedbar-directory-minus) + ("< >" . speedbar-directory) ("[+]" . speedbar-page-plus) ("[-]" . speedbar-page-minus) ("[?]" . speedbar-page) diff --git a/lisp/startup.el b/lisp/startup.el index 2f0ca4b2c19..f376fe5e0e1 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -220,7 +220,7 @@ Setting `init-file-user' does not prevent Emacs from loading "File containing site-wide run-time initializations. This file is loaded at run-time before `~/.emacs'. It contains inits that need to be in place for the entire site, but which, due to their -higher incidence of change, don't make sense to load into emacs' +higher incidence of change, don't make sense to load into Emacs's dumped image. Thus, the run-time load order is: 1. file described in this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'. @@ -293,8 +293,8 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." (let* ((this-dir (car dirs)) (contents (directory-files this-dir)) (default-directory this-dir) - (canonicalized (and (eq system-type 'windows-nt) - (untranslated-canonical-name this-dir)))) + (canonicalized (if (fboundp 'untranslated-canonical-name) + (untranslated-canonical-name this-dir)))) ;; The Windows version doesn't report meaningful inode ;; numbers, so use the canonicalized absolute file name of the ;; directory instead. @@ -343,8 +343,7 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; Give *Messages* the same default-directory as *scratch*, ;; just to keep things predictable. (let ((dir default-directory)) - (save-excursion - (set-buffer (get-buffer "*Messages*")) + (with-current-buffer "*Messages*" (setq default-directory dir))) ;; `user-full-name' is now known; reset its standard-value here. (put 'user-full-name 'standard-value @@ -357,32 +356,25 @@ or `CVS', and any subdirectory that contains a file named `.nosearch'." ;; of that dir into load-path, ;; Look for a leim-list.el file too. Loading it will register ;; available input methods. - (let ((tail load-path) - new) - (while tail - (push (car tail) new) - (condition-case nil - (let ((default-directory (car tail))) - (load (expand-file-name "subdirs.el" (car tail)) t t t))) - (condition-case nil - (let ((default-directory (car tail))) - (load (expand-file-name "leim-list.el" (car tail)) t t t))) - (setq tail (cdr tail)))) - (if (not (eq system-type 'vax-vms)) - (progn - ;; If the PWD environment variable isn't accurate, delete it. - (let ((pwd (getenv "PWD"))) - (and (stringp pwd) - ;; Use FOO/., so that if FOO is a symlink, file-attributes - ;; describes the directory linked to, not FOO itself. - (or (equal (file-attributes - (concat (file-name-as-directory pwd) ".")) - (file-attributes - (concat (file-name-as-directory default-directory) - "."))) - (setq process-environment - (delete (concat "PWD=" pwd) - process-environment))))))) + (dolist (dir load-path) + (let ((default-directory dir)) + (load (expand-file-name "subdirs.el") t t t)) + (let ((default-directory dir)) + (load (expand-file-name "leim-list.el") t t t))) + (unless (eq system-type 'vax-vms) + ;; If the PWD environment variable isn't accurate, delete it. + (let ((pwd (getenv "PWD"))) + (and (stringp pwd) + ;; Use FOO/., so that if FOO is a symlink, file-attributes + ;; describes the directory linked to, not FOO itself. + (or (equal (file-attributes + (concat (file-name-as-directory pwd) ".")) + (file-attributes + (concat (file-name-as-directory default-directory) + "."))) + (setq process-environment + (delete (concat "PWD=" pwd) + process-environment)))))) (setq default-directory (abbreviate-file-name default-directory)) (let ((menubar-bindings-done nil)) (unwind-protect diff --git a/lisp/subr.el b/lisp/subr.el index 9dd1e415212..49b85e18394 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -198,7 +198,7 @@ If N is bigger than the length of LIST, return LIST." list)) (defun butlast (list &optional n) - "Returns a copy of LIST with the last N elements removed." + "Return a copy of LIST with the last N elements removed." (if (and n (<= n 0)) list (nbutlast (copy-sequence list) n))) @@ -566,7 +566,7 @@ The order of bindings in a keymap matters when it is used as a menu." (defmacro kbd (keys) "Convert KEYS to the internal Emacs key representation. KEYS should be a string constant in the format used for -saving keyboard macros (see `insert-kbd-macro')." +saving keyboard macros (see `edmacro-mode')." (read-kbd-macro keys)) (put 'keyboard-translate-table 'char-table-extra-slots 0) @@ -641,10 +641,14 @@ The normal global definition of the character C-x indirects to this keymap.") (get (car obj) 'event-symbol-elements)))) (defun event-modifiers (event) - "Returns a list of symbols representing the modifier keys in event EVENT. + "Return a list of symbols representing the modifier keys in event EVENT. The elements of the list may include `meta', `control', `shift', `hyper', `super', `alt', `click', `double', `triple', `drag', -and `down'." +and `down'. +EVENT may be an event or an event type. If EVENT is a symbol +that has never been used in an event that has been read as input +in the current Emacs session, then this function can return nil, +even when EVENT actually has modifiers." (let ((type event)) (if (listp type) (setq type (car type))) @@ -670,8 +674,11 @@ and `down'." list)))) (defun event-basic-type (event) - "Returns the basic type of the given event (all modifiers removed). -The value is a printing character (not upper case) or a symbol." + "Return the basic type of the given event (all modifiers removed). +The value is a printing character (not upper case) or a symbol. +EVENT may be an event or an event type. If EVENT is a symbol +that has never been used in an event that has been read as input +in the current Emacs session, then this function may return nil." (if (consp event) (setq event (car event))) (if (symbolp event) @@ -1189,7 +1196,7 @@ Optional args SENTINEL and FILTER specify the sentinel and filter (make-obsolete 'process-kill-without-query "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'." - "21.5") + "21.4") (defun process-kill-without-query (process &optional flag) "Say no query needed if PROCESS is running when Emacs is exited. Optional second argument if non-nil says to require a query. @@ -1894,7 +1901,10 @@ See also `with-temp-file' and `with-output-to-string'." (kill-buffer nil))))) (defmacro with-local-quit (&rest body) - "Execute BODY with `inhibit-quit' temporarily bound to nil." + "Execute BODY, allowing quits to terminate BODY but not escape further. +When a quit terminates BODY, `with-local-quit' requests another quit when +it finishes. That quit will be processed in turn, the next time quitting +is again allowed." (declare (debug t) (indent 0)) `(condition-case nil (let ((inhibit-quit nil)) @@ -1959,6 +1969,27 @@ Uses the `derived-mode-parent' property of the symbol to trace backwards." (setq parent (get parent 'derived-mode-parent)))) parent)) +(defun find-tag-default () + "Determine default tag to search for, based on text at point. +If there is no plausible default, return nil." + (save-excursion + (while (looking-at "\\sw\\|\\s_") + (forward-char 1)) + (if (or (re-search-backward "\\sw\\|\\s_" + (save-excursion (beginning-of-line) (point)) + t) + (re-search-forward "\\(\\sw\\|\\s_\\)+" + (save-excursion (end-of-line) (point)) + t)) + (progn (goto-char (match-end 0)) + (buffer-substring-no-properties + (point) + (progn (forward-sexp -1) + (while (looking-at "\\s'") + (forward-char 1)) + (point)))) + nil))) + (defmacro with-syntax-table (table &rest body) "Evaluate BODY with syntax table of current buffer set to TABLE. The syntax table of the current buffer is saved, BODY is evaluated, and the @@ -2294,13 +2325,13 @@ which in most cases is shared with all other buffers in the same major mode." (defun global-unset-key (key) "Remove global binding of KEY. -KEY is a string representing a sequence of keystrokes." +KEY is a string or vector representing a sequence of keystrokes." (interactive "kUnset key globally: ") (global-set-key key nil)) (defun local-unset-key (key) "Remove local binding of KEY. -KEY is a string representing a sequence of keystrokes." +KEY is a string or vector representing a sequence of keystrokes." (interactive "kUnset key locally: ") (if (current-local-map) (local-set-key key nil)) diff --git a/lisp/term.el b/lisp/term.el index f1bd8d9a4f6..9866db7e29c 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -705,18 +705,18 @@ Buffer local variable.") ;;; faces -mm -(defcustom term-default-fg-color nil +(defcustom term-default-fg-color 'unspecified "Default color for foreground in `term'." :group 'term :type 'string) -(defcustom term-default-bg-color nil +(defcustom term-default-bg-color 'unspecified "Default color for background in `term'." :group 'term :type 'string) (defvar ansi-term-color-vector - [nil "black" "red" "green" "yellow" "blue" + [unspecified "black" "red" "green" "yellow" "blue" "magenta" "cyan" "white"]) ;;; Inspiration came from comint.el -mm @@ -3080,8 +3080,7 @@ See `term-prompt-regexp'." (setq term-current-face (append '(:underline t) term-current-face)))))) -; (message "Debug %S" term-current-face) - +;;; (message "Debug %S" term-current-face) (setq term-ansi-face-already-done 0)) diff --git a/lisp/term/mac-win.el b/lisp/term/mac-win.el index e42c2151701..c0ea7a9385e 100644 --- a/lisp/term/mac-win.el +++ b/lisp/term/mac-win.el @@ -141,6 +141,9 @@ (if clipboard (decode-coding-string clipboard selection-coding-system t))))) +;; Don't show the frame name; that's redundant. +(setq-default mode-line-frame-identification " ") + (defun mac-drag-n-drop (event) "Edit the files listed in the drag-n-drop event.\n\ Switch to a buffer editing the last file dropped." @@ -262,6 +265,9 @@ ascii:-*-Monaco-*-*-*-*-12-*-*-*-*-*-mac-roman") ;; Tell read-char how to convert special chars to ASCII (put 'return 'ascii-character 13) +(put 'tab 'ascii-character ?\t) +(put 'backspace 'ascii-character 127) +(put 'escape 'ascii-character ?\e) ;; ;; Available colors diff --git a/lisp/term/tty-colors.el b/lisp/term/tty-colors.el index 956d46738df..1de35822b39 100644 --- a/lisp/term/tty-colors.el +++ b/lisp/term/tty-colors.el @@ -864,15 +864,10 @@ of gray, thus the name." (if (< mag 1) 0 (acos (/ (+ r g b) mag))))) (defun tty-color-approximate (rgb &optional frame) - "Given a list of 3 rgb values in RGB, find the color in `tty-color-alist' -which is the best approximation in the 3-dimensional RGB space, -and return its description. - -Value is a list of the form \(NAME INDEX R G B\). Note that the returned -NAME is not necessarily the same string as the argument COLOR, because -the latter might need to be approximated if it is not supported directly. - -Each value of the RGB triplet should be in the range 0..65535 range. + "Find the color in `tty-color-alist' that best approximates RGB. +Value is a list of the form \(NAME INDEX R G B\). +The argument RGB should be an rgb value, that is, a list of three +integers in the 0..65535 range. FRAME defaults to the selected frame." (let* ((color-list (tty-color-alist frame)) (candidate (car color-list)) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index d9700809413..61602d1f355 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -2212,7 +2212,8 @@ order until succeed.") (if utf8 (setq text (x-select-utf8-or-ctext utf8 ctext)) ;; Othewise, choose CTEXT. - (setq text ctext)))) + (setq text ctext)) + (setq text utf8))) ;; If not yet decided, try STRING. (or text (setq text (condition-case nil diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index aff42866349..43671f0f725 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -2,7 +2,7 @@ ;; Copyright (C) 1998, 2000, 2001, 2002 Free Software Foundation, Inc. -;; Author: Manuel Serrano <Manuel.Serrano@unice.fr> +;; Author: Manuel Serrano <Manuel.Serrano@sophia.inria.fr> ;; Maintainer: FSF ;; Keywords: convenience @@ -1011,8 +1011,7 @@ Mostly we check word delimiters." (concat "^" word "\n")) ;; we mark the ispell process so it can be killed ;; when emacs is exited without query - (if (fboundp 'process-kill-without-query) - (process-kill-without-query ispell-process)) + (set-process-query-on-exit-flag ispell-process nil) ;; wait until ispell has processed word (while (progn (accept-process-output ispell-process) @@ -1065,7 +1064,7 @@ Mostly we check word delimiters." flyspell-duplicate-distance) t))))) (if flyspell-highlight-flag - (flyspell-highlight-duplicate-region start end) + (flyspell-highlight-duplicate-region start end poss) (message (format "duplicate `%s'" word)))) (t ;; incorrect highlight the location @@ -1540,8 +1539,9 @@ for the overlay." ;*---------------------------------------------------------------------*/ ;* flyspell-highlight-duplicate-region ... */ ;*---------------------------------------------------------------------*/ -(defun flyspell-highlight-duplicate-region (beg end) - "Set up an overlay on a duplicated word, in the buffer from BEG to END." +(defun flyspell-highlight-duplicate-region (beg end poss) + "Set up an overlay on a duplicated word, in the buffer from BEG to END. +??? What does POSS mean?" (let ((inhibit-read-only t)) (unless (run-hook-with-args-until-success 'flyspell-incorrect-hook beg end poss) @@ -1947,7 +1947,6 @@ The word checked is the word at the mouse position." mouse-pos (set-mouse-position (car mouse-pos) (/ (frame-width) 2) 2) - (unfocus-frame) (mouse-position)))) (setq event (list (list (car (cdr mouse-pos)) (1+ (cdr (cdr mouse-pos)))) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index 77c63379e2b..435e2e5f27a 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -1228,7 +1228,7 @@ for skipping in latex mode.") "*Lists of start and end keys to skip in HTML buffers. Same format as `ispell-skip-region-alist' Note - substrings of other matches must come last - (e.g. \"<[tT][tT]/\" and \"<[^ \t\n>]\").") + (e.g. \"<[tT][tT]/\" and \"<[^ \\t\\n>]\").") (defvar ispell-local-pdict ispell-personal-dictionary diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index 7b9ad8348ca..534e4e7b27b 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -1,4 +1,4 @@ -;;; reftex-auc.el --- RefTeX's interface to AUC TeX +;;; reftex-auc.el --- RefTeX's interface to AUCTeX ;; Copyright (c) 1997, 1998, 1999, 2000, 2003 Free Software Foundation, Inc. ;; Author: Carsten Dominik <dominik@science.uva.nl> diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index 28bf9f6cf28..1c4b89f0a62 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -1141,10 +1141,14 @@ on the line for the invalidity you want to see." 'occur-target tem))))) (goto-char prev-end)))) (with-current-buffer standard-output - (if (eq num-matches 0) - (insert "None!\n")) - (if (interactive-p) - (message "%d mismatches found" num-matches)))))) + (let ((no-matches (zerop num-matches))) + (if no-matches + (insert "None!\n")) + (if (interactive-p) + (message (cond (no-matches "No mismatches found") + ((= num-matches 1) "1 mismatch found") + (t "%d mismatches found")) + num-matches))))))) (defun tex-validate-region (start end) "Check for mismatched braces or $'s in region. @@ -1459,7 +1463,7 @@ Mark is left at original location." nil) (let ((proc (get-process "tex-shell"))) (set-process-sentinel proc 'tex-shell-sentinel) - (process-kill-without-query proc) + (set-process-query-on-exit-flag proc nil) (tex-shell) (while (zerop (buffer-size)) (sleep-for 1))))) @@ -1928,7 +1932,7 @@ for the error messages." (re-search-forward "^l\\.\\([0-9]+\\) \\(\\.\\.\\.\\)?\\(.*\\)$" nil 'move)) (let* ((this-error (copy-marker begin-of-error)) - (linenum (string-to-int (match-string 1))) + (linenum (string-to-number (match-string 1))) (error-text (regexp-quote (match-string 3))) (filename (save-excursion diff --git a/lisp/vc-svn.el b/lisp/vc-svn.el index 82c09cbd435..fafb5eff7cd 100644 --- a/lisp/vc-svn.el +++ b/lisp/vc-svn.el @@ -1,6 +1,7 @@ ;;; vc-svn.el --- non-resident support for Subversion version-control -;; Copyright (C) 1995,98,99,2000,2001,02,2003 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1998, 1999, 2000, 2001, 2002, 2003, 2004 +;; Free Software Foundation, Inc. ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier <monnier@gnu.org> @@ -363,7 +364,10 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (append (vc-switches nil 'diff) '("/dev/null"))) ;; Even if it's empty, it's locally modified. 1) - (let* ((switches (vc-switches 'SVN 'diff)) + (let* ((switches + (if vc-svn-diff-switches + (vc-switches 'SVN 'diff) + (list "-x" (mapconcat 'identity (vc-switches nil 'diff) " ")))) (async (and (vc-stay-local-p file) (or oldvers newvers) ; Svn diffs those locally. (fboundp 'start-process)))) @@ -371,8 +375,7 @@ The changes are between FIRST-VERSION and SECOND-VERSION." (if async 'async 0) file "diff" (append - (when switches - (list "-x" (mapconcat 'identity switches " "))) + switches (when oldvers (list "-r" (if newvers (concat oldvers ":" newvers) oldvers))))) @@ -504,5 +507,5 @@ essential information." (provide 'vc-svn) -;;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d +;; arch-tag: 02f10c68-2b4d-453a-90fc-1eee6cfb268d ;;; vc-svn.el ends here diff --git a/lisp/wdired.el b/lisp/wdired.el index 30ba2a3cd45..928ecd65339 100644 --- a/lisp/wdired.el +++ b/lisp/wdired.el @@ -455,6 +455,11 @@ non-nil means return old filename." (setq file-new (substitute-in-file-name file-new)) (if wdired-use-interactive-rename (wdired-search-and-rename file-ori file-new) + ;; If dired-rename-file autoloads dired-aux while + ;; dired-backup-overwrite is locally bound, + ;; dired-backup-overwrite won't be initialized. + ;; So we must ensure dired-aux is loaded. + (require 'dired-aux) (condition-case err (let ((dired-backup-overwrite nil)) (dired-rename-file file-ori file-new diff --git a/lisp/whitespace.el b/lisp/whitespace.el index e330febf938..40a234f02d6 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -820,6 +820,9 @@ If timer is not set, then set it to scan the files in (setq whitespace-rescan-timer nil)))) ;;;###autoload +(defalias 'global-whitespace-mode 'whitespace-global-mode) + +;;;###autoload (define-minor-mode whitespace-global-mode "Toggle using Whitespace mode in new buffers. With ARG, turn the mode on iff ARG is positive. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index 8029fb3d5a6..05ef4b95658 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -3153,6 +3153,8 @@ It will read a directory name from the minibuffer when invoked." (setq err "Empty sexp -- use `nil'?") (unless (widget-apply widget :match (read (current-buffer))) (setq err (widget-get widget :type-error)))) + ;; Allow whitespace after expression. + (skip-syntax-forward "\\s-") (if (and (not (eobp)) (not err)) (setq err (format "Junk at end of expression: %s" diff --git a/lisp/windmove.el b/lisp/windmove.el index 7008b86335e..642f04a1d8d 100644 --- a/lisp/windmove.el +++ b/lisp/windmove.el @@ -429,14 +429,12 @@ the return value from `windmove-coordinates-of-position' is (0 . 0) regardless of the where point is in the buffer and where the window is placed in the frame." (let* ((wind (if (null window) (selected-window) window)) - (usable-width (1- (window-width wind))) ; 1- for cont. column - (usable-height (1- (window-height wind))) ; 1- for mode line (big-hairy-result (compute-motion (window-start) '(0 . 0) pos - (cons usable-width usable-height) - usable-width + nil ; (window-width window-height) + nil ; window-width (cons (window-hscroll) 0) ; why zero? wind))) diff --git a/lisp/window.el b/lisp/window.el index 96bfc8b5581..5ec752f3f23 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -408,7 +408,7 @@ lines than are actually needed in the case where some error may be present." '(0 . 0) (- (point-max) (if ignore-final-newline 1 0)) (cons 0 100000000) - (window-width window) + nil nil window)))))) diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 7d43a10556e..0f9237f3409 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -58,8 +58,8 @@ The default value for this variable is `x-dnd-default-test-function'." ) "The functions to call for different protocols when a drop is made. -This variable is used by `x-dnd-handle-uri-list' and `x-dnd-handle-moz-url'. -The list contains of (REGEXP . FUNCTION) pairs. +This variable is used by `x-dnd-handle-uri-list', `x-dnd-handle-file-name' +and `x-dnd-handle-moz-url'. The list contains of (REGEXP . FUNCTION) pairs. The functions shall take two arguments, URL, which is the URL dropped and ACTION which is the action to be performed for the drop (move, copy, link, private or ask). @@ -104,9 +104,7 @@ is successful, nil if not." :type 'boolean :group 'x) -;; Internal variables - -(defvar x-dnd-known-types +(defcustom x-dnd-known-types '("text/uri-list" "text/x-moz-url" "_NETSCAPE_URL" @@ -121,7 +119,12 @@ is successful, nil if not." "TEXT" ) "The types accepted by default for dropped data. -The types are chosen in the order they appear in the list.") +The types are chosen in the order they appear in the list." + :type '(repeat string) + :group 'x +) + +;; Internal variables (defvar x-dnd-current-state nil "The current state for a drop. @@ -865,7 +868,7 @@ FORMAT is 32 (not used). MESSAGE is the data part of an XClientMessageEvent." timestamp) (x-dnd-forget-drop frame))) - (t (error "Unknown Motif DND message %s %s" message data))))) + (t (error "Unknown Motif DND message %s %s" message-atom data))))) ;;; |