comparison lisp/mh-e/mh-comp.el @ 68465:37d03b3298bf

The Great Cleanup Remove circular dependencies. mh-e.el now includes few require statements and stands alone. Other files should need to require mh-e.el, which requires mh-loaddefs.el, plus variable-only files such as mh-scan.el. Remove unneeded require statements. Remove unneeded load statements, or replace them with non-fatal require statements. Break out components into their own files that were often spread between many files. As a result, many functions that are now only used within a single file no longer need to be autoloaded. Rearrange and provide consistent headings. Untabify. * mh-acros.el: Update commentary to reflect current usage. Add autoload cookies to all macros. (mh-require-cl): Merge docstring and comment. (mh-do-in-xemacs): Fix typo in docstring. (assoc-string): Move to new file mh-compat.el. (with-mh-folder-updating, mh-in-show-buffer) (mh-do-at-event-location, mh-seq-msgs): Move here from mh-utils.el. (mh-iterate-on-messages-in-region, mh-iterate-on-range): Move here from mh-seq.el. * mh-alias.el (mh-address-mail-regexp) (mh-goto-address-find-address-at-point): Move here from mh-utils.el. (mh-folder-line-matches-show-buffer-p): Move here from mh-e.el. * mh-buffers.el: Update descriptive text. * mh-comp.el (mh-note-repl, mh-note-forw, mh-note-dist): Move to new file mh-scan.el. (mh-yank-hooks, mh-to-field-choices, mh-position-on-field) (mh-letter-menu, mh-letter-mode-help-messages) (mh-letter-buttons-init-flag, mh-letter-mode) (mh-font-lock-field-data, mh-letter-header-end) (mh-auto-fill-for-letter, mh-to-field, mh-to-fcc) (mh-file-is-vcard-p, mh-insert-signature, mh-check-whom) (mh-insert-letter, mh-extract-from-attribution, mh-yank-cur-msg) (mh-filter-out-non-text, mh-insert-prefix-string) (mh-current-fill-prefix, mh-open-line, mh-complete-word) (mh-folder-expand-at-point, mh-letter-complete-function-alist) (mh-letter-complete, mh-letter-complete-or-space) (mh-letter-confirm-address, mh-letter-header-field-at-point) (mh-letter-next-header-field-or-indent) (mh-letter-next-header-field, mh-letter-previous-header-field) (mh-letter-skipped-header-field-p) (mh-letter-skip-leading-whitespace-in-header-field) (mh-hidden-header-keymap) (mh-letter-toggle-header-field-display-button) (mh-letter-toggle-header-field-display) (mh-letter-truncate-header-field, mh-letter-mode-map): Move to new file mh-letter.el. (mh-letter-mode-map, mh-sent-from-folder, mh-send-args) (mh-pgp-support-flag, mh-x-mailer-string) (mh-letter-header-field-regexp): Move to mh-e.el. (mh-goto-header-field, mh-goto-header-end) (mh-extract-from-header-value, mh-beginning-of-word): Move to mh-utils.el. (mh-insert-header-separator): Move to mh-comp.el. (mh-display-completion-list-compat): Move to new file mh-compat.el. * mh-compat.el: New file. (assoc-string): Move here from mh-acros.el. (mh-display-completion-list): Move here from mh-comp.el. * mh-customize.el: Move content into mh-e.el and remove. * mh-e.el (mh-folder-mode-map, mh-folder-seq-tool-bar-map) (mh-folder-tool-bar-map, mh-inc-spool-map, mh-letter-mode-map) (mh-letter-tool-bar-map, mh-search-mode-map, mh-show-mode-map) (mh-show-seq-tool-bar-map, mh-show-tool-bar-map): All maps now declared here so that they can be used in docstrings. (mh-sent-from-folder, mh-sent-from-msg) (mh-letter-header-field-regexp, mh-pgp-support-flag) (mh-x-mailer-string): Move here from mh-comp.el. (mh-folder-line-matches-show-buffer-p): Move to mh-alias.el. (mh-thread-scan-line-map, mh-thread-scan-line-map-stack): Move here from mh-seq.el. (mh-draft-folder, mh-inbox, mh-user-path, mh-current-folder) (mh-previous-window-config, mh-seen-list, mh-seq-list) (mh-show-buffer, mh-showing-mode, mh-globals-hash) (mh-show-folder-buffer, mh-mail-header-separator) (mh-unseen-seq, mh-previous-seq, mh-page-to-next-msg-flag) (mh-signature-separator, mh-signature-separator-regexp) (mh-list-to-string, mh-list-to-string-1): Move here from mh-utils.el. (mh-index-max-cmdline-args, mh-xargs, mh-quote-for-shell) (mh-exec-cmd, mh-exec-cmd-error, mh-exec-cmd-daemon) (mh-exec-cmd-env-daemon, mh-process-daemon, mh-exec-cmd-quiet) (mh-exec-cmd-output) (mh-exchange-point-and-mark-preserving-active-mark) (mh-exec-lib-cmd-output, mh-handle-process-error): Move here from deprecated file mh-exec.el. (mh-path): Move here from deprecated file mh-customize.el. (mh-sys-path, mh-variants, mh-variant-in-use, mh-progs, mh-lib) (mh-flists-present-flag, mh-variants, mh-variant-mh-info) (mh-variant-mu-mh-info, mh-variant-nmh-info, mh-file-command-p) (mh-variant-set-variant, mh-variant-p, mh-profile-component) (mh-profile-component-value, mh-defface-compat): Move here from deprecated file mh-init.el. (mh-goto-next-button, mh-folder-mime-action) (mh-folder-toggle-mime-part, mh-folder-inline-mime-part) (mh-folder-save-mime-part, mh-toggle-mime-buttons): Move to to mh-mime.el. (mh-scan-format-mh, mh-scan-format-nmh, mh-note-deleted) (mh-note-refiled, mh-note-cur, 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-sent-to-me-sender-regexp) (mh-scan-cmd-note-width, mh-scan-destination-width) (mh-scan-date-width, mh-scan-date-flag-width) (mh-scan-from-mbox-width, mh-scan-from-mbox-sep-width) (mh-scan-field-destination-offset) (mh-scan-field-from-start-offset, mh-scan-field-from-end-offset) (mh-scan-field-subject-start-offset, mh-scan-format) (mh-msg-num-width-to-column, mh-set-cmd-note): Move to new file mh-scan.el. (mh-partial-folder-mode-line-annotation) (mh-folder-font-lock-keywords, mh-folder-font-lock-subject) (mh-generate-sequence-font-lock, mh-last-destination) (mh-last-destination-write, mh-first-msg-num, mh-last-msg-num) (mh-rmail, mh-nmail, mh-delete-msg, mh-delete-msg-no-motion) (mh-execute-commands, mh-first-msg, mh-header-display) (mh-inc-folder, mh-last-msg, mh-next-undeleted-msg) (mh-folder-from-address, mh-prompt-for-refile-folder) (mh-refile-msg, mh-refile-or-write-again, mh-quit, mh-page-msg) (mh-previous-page, mh-previous-undeleted-msg) (mh-previous-unread-msg, mh-next-button, mh-prev-button) (mh-reset-threads-and-narrowing, mh-rescan-folder) (mh-write-msg-to-file, mh-toggle-showing, mh-undo) (mh-visit-folder, mh-update-sequences, mh-delete-a-msg) (mh-refile-a-msg, mh-next-msg, mh-next-unread-msg) (mh-set-scan-mode, mh-undo-msg, mh-make-folder) (mh-folder-sequence-menu, mh-folder-message-menu) (mh-folder-folder-menu, mh-remove-xemacs-horizontal-scrollbar) (mh-write-file-functions-compat, mh-folder-mode) (mh-restore-desktop-buffer, mh-scan-folder) (mh-regenerate-headers, mh-generate-new-cmd-note) (mh-get-new-mail, mh-make-folder-mode-line, mh-goto-cur-msg) (mh-process-or-undo-commands, mh-process-commands) (mh-update-unseen, mh-delete-scan-msgs) (mh-outstanding-commands-p): Move to new file mh-folder.el. (mh-mapc, mh-colors-available-p, mh-colors-in-use-p) (mh-make-local-vars, mh-coalesce-msg-list, mh-greaterp) (mh-lessp): Move to mh-utils.el. (mh-parse-flist-output-line, mh-folder-size-folder) (mh-folder-size-flist, mh-folder-size, mh-add-sequence-notation) (mh-remove-sequence-notation, mh-remove-cur-notation) (mh-remove-all-notation, mh-delete-seq-locally) (mh-read-folder-sequences, mh-read-msg-list) (mh-notate-user-sequences, mh-internal-seqs, mh-internal-seq) (mh-valid-seq-p, mh-delete-msg-from-seq, mh-catchup) (mh-delete-a-msg-from-seq, mh-undefine-sequence) (mh-define-sequence, mh-seq-containing-msg): Move to mh-seq.el. (mh-xemacs-flag) (mh-customize, mh-e, mh-alias, mh-folder, mh-folder-selection) (mh-identity, mh-inc, mh-junk, mh-letter, mh-ranges) (mh-scan-line-formats, mh-search, mh-sending-mail, mh-sequences) (mh-show, mh-speedbar, mh-thread, mh-tool-bar, mh-hooks) (mh-faces, mh-alias-completion-ignore-case-flag) (mh-alias-expand-aliases-flag, mh-alias-flash-on-comma) (mh-alias-insert-file, mh-alias-insertion-location) (mh-alias-local-users, mh-alias-local-users-prefix) (mh-alias-passwd-gecos-comma-separator-flag) (mh-new-messages-folders, mh-ticked-messages-folders) (mh-large-folder, mh-recenter-summary-flag) (mh-recursive-folders-flag, mh-sortm-args) (mh-default-folder-for-message-function, mh-default-folder-list) (mh-default-folder-must-exist-flag, mh-default-folder-prefix) (mh-identity-list, mh-auto-fields-list) (mh-auto-fields-prompt-flag, mh-identity-default) (mh-identity-handlers, mh-inc-prog, mh-inc-spool-list) (mh-junk-choice, mh-junk-function-alist, mh-junk-choose) (mh-junk-background, mh-junk-disposition, mh-junk-program) (mh-compose-insertion, mh-compose-skipped-header-fields) (mh-compose-space-does-completion-flag) (mh-delete-yanked-msg-window-flag) (mh-extract-from-attribution-verb, mh-ins-buf-prefix) (mh-letter-complete-function, mh-letter-fill-column) (mh-mml-method-default, mh-signature-file-name) (mh-signature-separator-flag, mh-x-face-file, mh-yank-behavior) (mh-interpret-number-as-range-flag, mh-adaptive-cmd-note-flag) (mh-scan-format-file-check, mh-scan-format-file) (mh-adaptive-cmd-note-flag-check, mh-scan-prog) (mh-search-program, mh-compose-forward-as-mime-flag) (mh-compose-letter-function, mh-compose-prompt-flag) (mh-forward-subject-format, mh-insert-x-mailer-flag) (mh-redist-full-contents-flag, mh-reply-default-reply-to) (mh-reply-show-message-flag, mh-refile-preserves-sequences-flag) (mh-tick-seq, mh-update-sequences-after-mh-show-flag) (mh-bury-show-buffer-flag, mh-clean-message-header-flag) (mh-decode-mime-flag, mh-display-buttons-for-alternatives-flag) (mh-display-buttons-for-inline-parts-flag) (mh-do-not-confirm-flag, mh-fetch-x-image-url) (mh-graphical-smileys-flag, mh-graphical-emphasis-flag) (mh-highlight-citation-style) (mh-invisible-header-fields-internal) (mh-delay-invisible-header-generation-flag) (mh-invisible-header-fields, mh-invisible-header-fields-default) (mh-invisible-header-fields-compiled, mh-invisible-headers) (mh-lpr-command-format, mh-max-inline-image-height) (mh-max-inline-image-width, mh-mhl-format-file) (mh-mime-save-parts-default-directory, mh-print-background-flag) (mh-show-maximum-size, mh-show-use-goto-addr-flag) (mh-show-use-xface-flag, mh-store-default-directory) (mh-summary-height, mh-speed-update-interval) (mh-show-threads-flag, mh-tool-bar-search-function) (mh-after-commands-processed-hook, mh-alias-reloaded-hook) (mh-before-commands-processed-hook, mh-before-quit-hook) (mh-before-send-letter-hook, mh-delete-msg-hook) (mh-find-path-hook, mh-folder-mode-hook, mh-forward-hook) (mh-inc-folder-hook, mh-insert-signature-hook) (mh-kill-folder-suppress-prompt-hooks, mh-letter-mode-hook) (mh-mh-to-mime-hook, mh-search-mode-hook, mh-quit-hook) (mh-refile-msg-hook, mh-show-hook, mh-show-mode-hook) (mh-unseen-updated-hook, mh-min-colors-defined-flag) (mh-folder-address, mh-folder-body) (mh-folder-cur-msg-number, mh-folder-date, mh-folder-deleted) (mh-folder-followup, mh-folder-msg-number, mh-folder-refiled) (mh-folder-sent-to-me-hint, mh-folder-sent-to-me-sender) (mh-folder-subject, mh-folder-tick, mh-folder-to) (mh-search-folder, mh-letter-header-field, mh-show-cc) (mh-show-date, mh-show-from, mh-show-header, mh-show-pgg-bad) (mh-show-pgg-good, mh-show-pgg-unknown, mh-show-signature) (mh-show-subject, mh-show-to, mh-show-xface, mh-speedbar-folder) (mh-speedbar-folder-with-unseen-messages) (mh-speedbar-selected-folder) (mh-speedbar-selected-folder-with-unseen-messages): Move here from deprecated file mh-customize.el. * mh-exec.el: Move content into mh-e.el and remove. * mh-folder.el: New file. Contains mh-folder-mode from mh-e.el * mh-funcs.el (mh-note-copied, mh-note-printed): Move to new file mh-scan.el. (mh-ephem-message, mh-help, mh-prefix-help): Move to mh-utils.el. * mh-gnus.el (mm-uu-dissect-text-parts): Add. (mh-mail-abbrev-make-syntax-table): Move to mh-utils.el and rename to mail-abbrev-make-syntax-table. * mh-identity.el (mh-identity-menu): New variable for existing menu. (mh-identity-make-menu-no-autoload): New alias for mh-identity-make-menu which can be called from mh-e.el. (mh-identity-list-set): Move to mh-e.el. (mh-identity-add-menu): New function (mh-insert-identity): Add optional argument maybe-insert so that local variable mh-identity-local does not have to be visible. (mh-identity-handler-default): * mh-inc.el (mh-inc-spool-map): Move declaration to mh-e.el (with rest of keymaps). Update key binding for ? to call mh-help with help messages in new argument. (mh-inc-spool-make-no-autoload): New alias for mh-inc-spool-make which can be called from mh-e.el. (mh-inc-spool-list-set): Simplify update of mh-inc-spool-map-help. * mh-init.el: Move content into mh-e.el and remove. * mh-junk.el: Update requires, untabify, and add mh-autoload cookies. * mh-letter.el: New file. Contains mh-letter-mode from mh-comp.el. * mh-limit.el: New file. Contains display limit commands from mh-mime.el. * mh-mime.el: Rearrange for consistency with other files. (mh-buffer-data, mh-mm-inline-media-tests): Move here from mh-utils.el. (mh-folder-inline-mime-part, mh-folder-save-mime-part) (mh-folder-toggle-mime-part, mh-toggle-mime-buttons) (mh-goto-next-button): Move here from mh-e.el. * mh-print.el: Rearrange for consistency with other files. * mh-scan.el: New file. Contains scan line constants and utilities from XXX, mh-funcs, mh-utils.el. * mh-search.el: Rearrange for consistency with other files. (mh-search-mode-map): Drop C-c C-f {dr} bindings since these fields which don't exist in the saved header. Replace C-c C-f f with C-c C-f m per mail-mode consistency. (mh-search-mode): Use mh-set-help instead of setting mh-help-messages. * mh-seq.el (mh-thread-message, mh-thread-container) (mh-thread-id-hash, mh-thread-subject-hash, mh-thread-id-table) (mh-thread-id-index-map, mh-thread-index-id-map) (mh-thread-scan-line-map, mh-thread-scan-line-map-stack) (mh-thread-subject-container-hash, mh-thread-duplicates) (mh-thread-history, mh-thread-body-width) (mh-thread-find-msg-subject mh-thread-initialize-hash) (mh-thread-initialize, mh-thread-id-container) (mh-thread-remove-parent-link, mh-thread-add-link) (mh-thread-ancestor-p, mh-thread-get-message-container) (mh-thread-get-message, mh-thread-canonicalize-id) (mh-thread-prune-subject, mh-thread-container-subject) (mh-thread-rewind-pruning, mh-thread-prune-containers) (mh-thread-sort-containers, mh-thread-group-by-subject) (mh-thread-process-in-reply-to, mh-thread-set-tables) (mh-thread-update-id-index-maps, mh-thread-generate) (mh-thread-inc, mh-thread-generate-scan-lines) (mh-thread-parse-scan-line, mh-thread-update-scan-line-map) (mh-thread-add-spaces, mh-thread-print-scan-lines) (mh-thread-folder, mh-toggle-threads, mh-thread-forget-message) (mh-thread-current-indentation-level, mh-thread-next-sibling) (mh-thread-previous-sibling, mh-thread-immediate-ancestor) (mh-thread-ancestor, mh-thread-find-children) (mh-message-id-regexp, mh-thread-delete, mh-thread-refile): Move to new file mh-thread.el. (mh-subject-to-sequence, mh-subject-to-sequence-unthreaded) (mh-subject-to-sequence-threaded, mh-edit-pick-expr) (mh-pick-args-list, mh-narrow-to-subject, mh-narrow-to-from) (mh-narrow-to-cc, mh-narrow-to-to, mh-narrow-to-header-field) (mh-current-message-header-field, mh-narrow-to-range) (mh-delete-subject, mh-delete-subject-or-thread): Move to new file mh-limit.el. (mh-iterate-on-messages-in-region, mh-iterate-on-range): Move to mh-acros.el. (mh-internal-seqs, mh-catchup, mh-delete-msg-from-seq) (mh-internal-seq, mh-valid-seq-p, mh-seq-containing-msg) (mh-define-sequence, mh-undefine-sequence) (mh-delete-a-msg-from-seq, mh-delete-seq-locally) (mh-folder-size, mh-folder-size-flist, mh-folder-size-folder) (mh-parse-flist-output-line, mh-read-folder-sequences) (mh-read-msg-list, mh-notate-user-sequences) (mh-remove-cur-notation, mh-add-sequence-notation) (mh-remove-sequence-notation, mh-remove-all-notation): Move here from mh-e.el. (mh-make-seq, mh-seq-name, mh-find-seq, mh-seq-to-msgs) (mh-add-msgs-to-seq, mh-notate): Move here from mh-utils.el. * mh-show.el: New file. Contains mh-show-mode from mh-utils.el. * mh-speed.el: Rearrange for consistency with other files. * mh-thread.el: New file. Contains threading code from mh-seq.el. * mh-tool-bar.el: New file. Contains tool bar creation code from deprecated file mh-customize.el. * mh-utils.el (recursive-load-depth-limit): Remove setting. No longer needed. (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, mh-cmd-note, mh-note-seq) (mh-update-scan-format, mh-msg-num-width): Move to new file mh-scan.el. (mh-show-buffer-mode-line-buffer-id, mh-letter-header-font-lock) (mh-header-field-font-lock, mh-header-to-font-lock) (mh-header-cc-font-lock, mh-header-subject-font-lock) (mh-show-font-lock-keywords) (mh-show-font-lock-keywords-with-cite) (mh-show-font-lock-fontify-region) (mh-gnus-article-highlight-citation, mh-showing-with-headers) (mh-start-of-uncleaned-message, mh-invalidate-show-buffer) (mh-unvisit-file, mh-defun-show-buffer, mh-show-mode-map) (mh-show-sequence-menu, mh-show-message-menu) (mh-show-folder-menu, mh-show-mode, mh-show-addr) (mh-maybe-show, mh-show, mh-show-msg, mh-show-unquote-From) (mh-msg-folder, mh-display-msg, mh-clean-msg-header): Move to new file mh-show.el. (mh-mail-header-separator, mh-signature-separator-regexp) (mh-signature-separator, mh-globals-hash, mh-user-path) (mh-draft-folder, mh-unseen-seq, mh-previous-seq, mh-inbox) (mh-previous-window-config, mh-current-folder mh-show-buffer) (mh-showing-mode, mh-show-mode-map, mh-show-folder-buffer) (mh-showing-mode, mh-seq-list, mh-seen-list, mh-summary-height) (mh-list-to-string, mh-list-to-string-1): Move to mh-e.el. (mh-buffer-data, mh-mm-inline-media-tests): Move to mh-mime.el. (mh-address-mail-regexp, mh-goto-address-find-address-at-point): Move to mh-alias.el. (mh-letter-font-lock-keywords): Move to new file mh-letter.el. (mh-folder-filename, mh-msg-count, mh-recenter, mh-msg-filename) (mh-show-mouse, mh-modify, mh-goto-msg, mh-set-folder-modified-p): Move to new file mh-folder.el. (with-mh-folder-updating, mh-in-show-buffer) (mh-do-at-event-location, mh-seq-msgs): Moved to mh-acros.el. (mh-make-seq, mh-seq-name, mh-notate, mh-find-seq) (mh-seq-to-msgs, mh-add-msgs-to-seq, mh-canonicalize-sequence): Moved to mh-seq.el. (mh-show-xface-function, mh-uncompface-executable, mh-face-to-png) (mh-uncompface, mh-icontopbm, mh-face-foreground-compat) (mh-face-background-compat, mh-face-display-function) (mh-show-xface, mh-picon-directory-list) (mh-picon-existing-directory-list) (mh-picon-cache, mh-picon-image-types) (mh-picon-set-directory-list, mh-picon-get-image) (mh-picon-file-contents, mh-picon-generate-path) (mh-x-image-cache-directory, mh-x-image-scaling-function) (mh-wget-executable, mh-wget-choice, mh-wget-option) (mh-x-image-temp-file, mh-x-image-url, mh-x-image-marker) (mh-x-image-url-cache-file, mh-x-image-scale-with-pnm) (mh-x-image-scale-with-convert) (url-unreserved-chars, url-hexify-string) (mh-x-image-url-cache-canonicalize) (mh-x-image-set-download-state, mh-x-image-get-download-state) (mh-x-image-url-fetch-image, mh-x-image-display) (mh-x-image-scale-and-display, mh-x-image-url-sane-p) (mh-x-image-url-display): Move to new file mh-xface.el. (mh-logo-display): Call mh-image-load-path. (mh-find-path-run, mh-find-path): Move here from deprecated file mh-init.el. (mh-help-messages): Now an alist of modes to an alist of messages. (mh-set-help): New function used to set mh-help-messages (mh-help): Adjust for new format of mh-help-messages. Add help-messages argument. (mh-prefix-help): Refactor to use mh-help. (mh-coalesce-msg-list, mh-greaterp, mh-lessp): Move here from mh-e.el. (mh-clear-sub-folders-cache): New function added to avoid exposing mh-sub-folders-cache variable. * mh-xface.el: New file. Contains X-Face and Face header field display routines from mh-utils.el.
author Bill Wohler <wohler@newt.com>
date Sun, 29 Jan 2006 19:34:57 +0000
parents 0c77c0b9a620
children a58223a143bc
comparison
equal deleted inserted replaced
68464:79464a6167f5 68465:37d03b3298bf
1 ;;; mh-comp.el --- MH-E functions for composing messages 1 ;;; mh-comp.el --- MH-E functions for composing and sending messages
2 2
3 ;; Copyright (C) 1993, 1995, 1997, 3 ;; Copyright (C) 1993, 1995, 1997,
4 ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. 4 ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
5 5
6 ;; Author: Bill Wohler <wohler@newt.com> 6 ;; Author: Bill Wohler <wohler@newt.com>
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA. 26 ;; Boston, MA 02110-1301, USA.
27 27
28 ;;; Commentary: 28 ;;; Commentary:
29 29
30 ;; Internal support for MH-E package. 30 ;; This file includes the functions in the MH-Folder maps that get us
31 ;; into MH-Letter mode, as well the functions in the MH-Letter mode
32 ;; that are used to send the mail. Other that those, functions that
33 ;; are needed in mh-letter.el should be found there.
31 34
32 ;;; Change Log: 35 ;;; Change Log:
33 36
34 ;;; Code: 37 ;;; Code:
35 38
36 ;;(message "> mh-comp")
37 (eval-when-compile (require 'mh-acros))
38 (mh-require-cl)
39
40 (require 'easymenu)
41 (require 'gnus-util)
42 (require 'mh-buffers)
43 (require 'mh-e) 39 (require 'mh-e)
44 (require 'mh-gnus) 40 (require 'mh-gnus) ;needed because mh-gnus.el not compiled
45 41 (require 'mh-scan)
46 (eval-when (compile load eval) 42
47 (ignore-errors (require 'mailabbrev))) 43 (require 'sendmail)
48 ;;(message "< mh-comp") 44
49 45 (autoload 'easy-menu-add "easymenu")
50 46 (autoload 'mml-insert-tag "mml")
51
52 ;;; Autoloads
53
54 (autoload 'mail-mode-fill-paragraph "sendmail")
55 (autoload 'mm-handle-displayed-p "mm-decode")
56
57 (autoload 'sc-cite-original "sc" 47 (autoload 'sc-cite-original "sc"
58 "Workhorse citing function which performs the initial citation. 48 "Workhorse citing function which performs the initial citation.
59 This is callable from the various mail and news readers' reply 49 This is callable from the various mail and news readers' reply
60 function according to the agreed upon standard. See `sc-describe' 50 function according to the agreed upon standard. See `sc-describe'
61 for more details. `sc-cite-original' does not do any yanking of the 51 for more details. `sc-cite-original' does not do any yanking of the
78 when this function is called. Also, the hook `sc-pre-hook' is run 68 when this function is called. Also, the hook `sc-pre-hook' is run
79 before, and `sc-post-hook' is run after the guts of this function.") 69 before, and `sc-post-hook' is run after the guts of this function.")
80 70
81 71
82 72
83 ;;; Site customization (see also mh-utils.el): 73 ;;; Site Customization
84 74
85 (defvar mh-send-prog "send" 75 (defvar mh-send-prog "send"
86 "Name of the MH send program. 76 "Name of the MH send program.
87 Some sites need to change this because of a name conflict.") 77 Some sites need to change this because of a name conflict.")
88 78
91 This allows transaction log to be visible if -watch, -verbose or 81 This allows transaction log to be visible if -watch, -verbose or
92 -snoop are used.") 82 -snoop are used.")
93 83
94 84
95 85
96 ;;; Scan Line Formats 86 ;;; Variables
97
98 (defvar mh-note-repl ?-
99 "Messages that have been replied to are marked by this character.")
100
101 (defvar mh-note-forw ?F
102 "Messages that have been forwarded are marked by this character.")
103
104 (defvar mh-note-dist ?R
105 "Messages that have been redistributed are marked by this character.")
106
107 (defvar mh-yank-hooks nil
108 "Obsolete hook for modifying a citation just inserted in the mail buffer.
109
110 Each hook function can find the citation between point and mark.
111 And each hook function should leave point and mark around the
112 citation text as modified.
113
114 This is a normal hook, misnamed for historical reasons. It is
115 semi-obsolete and is only used if `mail-citation-hook' is nil.")
116 87
117 (defvar mh-comp-formfile "components" 88 (defvar mh-comp-formfile "components"
118 "Name of file to be used as a skeleton for composing messages. 89 "Name of file to be used as a skeleton for composing messages.
119 90
120 Default is \"components\". 91 Default is \"components\".
143 (defvar mh-rejected-letter-start 114 (defvar mh-rejected-letter-start
144 (format "^%s$" 115 (format "^%s$"
145 (regexp-opt 116 (regexp-opt
146 '("Content-Type: message/rfc822" ;MIME MDN 117 '("Content-Type: message/rfc822" ;MIME MDN
147 "------ This is a copy of the message, including all the headers. ------";from exim 118 "------ This is a copy of the message, including all the headers. ------";from exim
148 "--- Below this line is a copy of the message."; from qmail 119 "--- Below this line is a copy of the message."; from qmail
149 " ----- Unsent message follows -----" ;from sendmail V5 120 " ----- Unsent message follows -----" ;from sendmail V5
150 " --------Unsent Message below:" ; from sendmail at BU 121 " --------Unsent Message below:" ; from sendmail at BU
151 " ----- Original message follows -----" ;from sendmail V8 122 " ----- Original message follows -----" ;from sendmail V8
152 "------- Unsent Draft" ;from MH itself 123 "------- Unsent Draft" ;from MH itself
153 "---------- Original Message ----------" ;from zmailer 124 "---------- Original Message ----------" ;from zmailer
159 (defvar mh-new-draft-cleaned-headers 130 (defvar mh-new-draft-cleaned-headers
160 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:" 131 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
161 "Regexp of header lines to remove before offering a message as a new draft\\<mh-folder-mode-map>. 132 "Regexp of header lines to remove before offering a message as a new draft\\<mh-folder-mode-map>.
162 Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.") 133 Used by the \\[mh-edit-again] and \\[mh-extract-rejected-mail] commands.")
163 134
164 (defvar mh-to-field-choices '(("a" . "Mail-Reply-To:")
165 ("b" . "Bcc:")
166 ("c" . "Cc:")
167 ("d" . "Dcc:")
168 ("f" . "Fcc:")
169 ("l" . "Mail-Followup-To:")
170 ("m" . "From:")
171 ("r" . "Reply-To:")
172 ("s" . "Subject:")
173 ("t" . "To:"))
174 "Alist of (final-character . field-name) choices for `mh-to-field'.")
175
176 (defvar mh-letter-mode-map (copy-keymap text-mode-map)
177 "Keymap for composing mail.")
178
179 (defvar mh-letter-mode-syntax-table nil 135 (defvar mh-letter-mode-syntax-table nil
180 "Syntax table used by MH-E while in MH-Letter mode.") 136 "Syntax table used by MH-E while in MH-Letter mode.")
181 137
182 (if mh-letter-mode-syntax-table 138 (if mh-letter-mode-syntax-table
183 () 139 ()
184 (setq mh-letter-mode-syntax-table 140 (setq mh-letter-mode-syntax-table
185 (make-syntax-table text-mode-syntax-table)) 141 (make-syntax-table text-mode-syntax-table))
186 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table)) 142 (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
187 143
188 (defvar mh-sent-from-folder nil
189 "Folder of msg assoc with this letter.")
190
191 (defvar mh-sent-from-msg nil
192 "Number of msg assoc with this letter.")
193
194 (defvar mh-send-args nil 144 (defvar mh-send-args nil
195 "Extra args to pass to \"send\" command.") 145 "Extra args to pass to \"send\" command.")
196 146
197 (defvar mh-annotate-char nil 147 (defvar mh-annotate-char nil
198 "Character to use to annotate `mh-sent-from-msg'.") 148 "Character to use to annotate `mh-sent-from-msg'.")
201 "Field name for message annotation.") 151 "Field name for message annotation.")
202 152
203 (defvar mh-insert-auto-fields-done-local nil 153 (defvar mh-insert-auto-fields-done-local nil
204 "Buffer-local variable set when `mh-insert-auto-fields' called successfully.") 154 "Buffer-local variable set when `mh-insert-auto-fields' called successfully.")
205 (make-variable-buffer-local 'mh-insert-auto-fields-done-local) 155 (make-variable-buffer-local 'mh-insert-auto-fields-done-local)
156
157
158
159 ;;; MH-E Entry Points
206 160
207 ;;;###autoload 161 ;;;###autoload
208 (defun mh-smail () 162 (defun mh-smail ()
209 "Compose a message with the MH mail system. 163 "Compose a message with the MH mail system.
210 See `mh-send' for more details on composing mail." 164 See `mh-send' for more details on composing mail."
217 "Compose a message with the MH mail system in other window. 171 "Compose a message with the MH mail system in other window.
218 See `mh-send' for more details on composing mail." 172 See `mh-send' for more details on composing mail."
219 (interactive) 173 (interactive)
220 (mh-find-path) 174 (mh-find-path)
221 (call-interactively 'mh-send-other-window)) 175 (call-interactively 'mh-send-other-window))
176
177 (defun mh-send-other-window (to cc subject)
178 "Compose a message in another window.
179
180 See `mh-send' for more information and a description of how the
181 TO, CC, and SUBJECT arguments are used."
182 (interactive (list
183 (mh-interactive-read-address "To: ")
184 (mh-interactive-read-address "Cc: ")
185 (mh-interactive-read-string "Subject: ")))
186 (let ((pop-up-windows t))
187 (mh-send-sub to cc subject (current-window-configuration))))
222 188
223 (defvar mh-error-if-no-draft nil) ;raise error over using old draft 189 (defvar mh-error-if-no-draft nil) ;raise error over using old draft
224 190
225 ;;;###autoload 191 ;;;###autoload
226 (defun mh-smail-batch (&optional to subject other-headers &rest ignored) 192 (defun mh-smail-batch (&optional to subject other-headers &rest ignored)
268 (mh-send to "" subject) 234 (mh-send to "" subject)
269 (while other-headers 235 (while other-headers
270 (mh-insert-fields (concat (car (car other-headers)) ":") 236 (mh-insert-fields (concat (car (car other-headers)) ":")
271 (cdr (car other-headers))) 237 (cdr (car other-headers)))
272 (setq other-headers (cdr other-headers))))) 238 (setq other-headers (cdr other-headers)))))
239
240 ;; Shush compiler.
241 (eval-when-compile (mh-do-in-xemacs (defvar sendmail-coding-system)))
242
243 ;;;###autoload
244 (defun mh-send-letter (&optional arg)
245 "Save draft and send message.
246
247 When you are all through editing a message, you send it with this
248 command. You can give a prefix argument ARG to monitor the first stage
249 of the delivery\; this output can be found in a buffer called \"*MH-E
250 Mail Delivery*\".
251
252 The hook `mh-before-send-letter-hook' is run at the beginning of
253 this command. For example, if you want to check your spelling in
254 your message before sending, add the function `ispell-message'.
255
256 In case the MH \"send\" program is installed under a different name,
257 use `mh-send-prog' to tell MH-E the name."
258 (interactive "P")
259 (run-hooks 'mh-before-send-letter-hook)
260 (if (and (mh-insert-auto-fields t)
261 mh-auto-fields-prompt-flag
262 (goto-char (point-min)))
263 (if (not (y-or-n-p "Auto fields inserted, send? "))
264 (error "Send aborted")))
265 (cond ((mh-mh-directive-present-p)
266 (mh-mh-to-mime))
267 ((or (mh-mml-tag-present-p) (not (mh-ascii-buffer-p)))
268 (mh-mml-to-mime)))
269 (save-buffer)
270 (message "Sending...")
271 (let ((draft-buffer (current-buffer))
272 (file-name buffer-file-name)
273 (config mh-previous-window-config)
274 (coding-system-for-write
275 (if (and (local-variable-p 'buffer-file-coding-system
276 (current-buffer)) ;XEmacs needs two args
277 ;; We're not sure why, but buffer-file-coding-system
278 ;; tends to get set to undecided-unix.
279 (not (memq buffer-file-coding-system
280 '(undecided undecided-unix undecided-dos))))
281 buffer-file-coding-system
282 (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
283 (and (boundp 'default-buffer-file-coding-system )
284 default-buffer-file-coding-system)
285 'iso-latin-1))))
286 ;; Adding a Message-ID field looks good, makes it easier to search for
287 ;; message in your +outbox, and best of all doesn't break threading for
288 ;; the recipient if you reply to a message in your +outbox.
289 (setq mh-send-args (concat "-msgid " mh-send-args))
290 ;; The default BCC encapsulation will make a MIME message unreadable.
291 ;; With nmh use the -mime arg to prevent this.
292 (if (and (mh-variant-p 'nmh)
293 (mh-goto-header-field "Bcc:")
294 (mh-goto-header-field "Content-Type:"))
295 (setq mh-send-args (concat "-mime " mh-send-args)))
296 (cond (arg
297 (pop-to-buffer mh-mail-delivery-buffer)
298 (erase-buffer)
299 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
300 "-nodraftfolder" mh-send-args file-name)
301 (goto-char (point-max)) ; show the interesting part
302 (recenter -1)
303 (set-buffer draft-buffer)) ; for annotation below
304 (t
305 (mh-exec-cmd-daemon mh-send-prog nil "-nodraftfolder" "-noverbose"
306 mh-send-args file-name)))
307 (if mh-annotate-char
308 (mh-annotate-msg mh-sent-from-msg
309 mh-sent-from-folder
310 mh-annotate-char
311 "-component" mh-annotate-field
312 "-text" (format "\"%s %s\""
313 (mh-get-header-field "To:")
314 (mh-get-header-field "Cc:"))))
315
316 (cond ((or (not arg)
317 (y-or-n-p "Kill draft buffer? "))
318 (kill-buffer draft-buffer)
319 (if config
320 (set-window-configuration config))))
321 (if arg
322 (message "Sending...done")
323 (message "Sending...backgrounded"))))
324
325 ;;;###autoload
326 (defun mh-fully-kill-draft ()
327 "Quit editing and delete draft message.
328
329 If for some reason you are not happy with the draft, you can use
330 this command to kill the draft buffer and delete the draft
331 message. Use the command \\[kill-buffer] if you don't want to
332 delete the draft message."
333 (interactive)
334 (if (y-or-n-p "Kill draft message? ")
335 (let ((config mh-previous-window-config))
336 (if (file-exists-p buffer-file-name)
337 (delete-file buffer-file-name))
338 (set-buffer-modified-p nil)
339 (kill-buffer (buffer-name))
340 (message "")
341 (if config
342 (set-window-configuration config)))
343 (error "Message not killed")))
344
345
346
347 ;;; MH-Folder Commands
348
349 ;; Alphabetical.
273 350
274 ;;;###mh-autoload 351 ;;;###mh-autoload
275 (defun mh-edit-again (message) 352 (defun mh-edit-again (message)
276 "Edit a MESSAGE to send it again. 353 "Edit a MESSAGE to send it again.
277 354
507 "-component" "Resent:" 584 "-component" "Resent:"
508 "-text" (format "\"%s %s\"" to cc))) 585 "-text" (format "\"%s %s\"" to cc)))
509 (kill-buffer draft) 586 (kill-buffer draft)
510 (message "Redistributing...done")))) 587 (message "Redistributing...done"))))
511 588
512 (defun mh-show-buffer-message-number (&optional buffer)
513 "Message number of displayed message in corresponding show buffer.
514
515 Return nil if show buffer not displayed.
516 If in `mh-letter-mode', don't display the message number being replied
517 to, but rather the message number of the show buffer associated with
518 our originating folder buffer.
519 Optional argument BUFFER can be used to specify the buffer."
520 (save-excursion
521 (if buffer
522 (set-buffer buffer))
523 (cond ((eq major-mode 'mh-show-mode)
524 (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
525 (string-to-number (substring buffer-file-name
526 (1+ number-start)))))
527 ((and (eq major-mode 'mh-folder-mode)
528 mh-show-buffer
529 (get-buffer mh-show-buffer))
530 (mh-show-buffer-message-number mh-show-buffer))
531 ((and (eq major-mode 'mh-letter-mode)
532 mh-sent-from-folder
533 (get-buffer mh-sent-from-folder))
534 (mh-show-buffer-message-number mh-sent-from-folder))
535 (t
536 nil))))
537
538 ;;;###mh-autoload 589 ;;;###mh-autoload
539 (defun mh-reply (message &optional reply-to includep) 590 (defun mh-reply (message &optional reply-to includep)
540 "Reply to a MESSAGE. 591 "Reply to a MESSAGE.
541 592
542 When you reply to a message, you are first prompted with \"Reply 593 When you reply to a message, you are first prompted with \"Reply
665 (mh-interactive-read-string "Subject: "))) 716 (mh-interactive-read-string "Subject: ")))
666 (let ((config (current-window-configuration))) 717 (let ((config (current-window-configuration)))
667 (delete-other-windows) 718 (delete-other-windows)
668 (mh-send-sub to cc subject config))) 719 (mh-send-sub to cc subject config)))
669 720
721
722
723 ;;; Support Routines
724
725 (defun mh-interactive-read-address (prompt)
726 "Read an address.
727 If `mh-compose-prompt-flag' is non-nil, then read an address with
728 PROMPT.
729 Otherwise return the empty string."
730 (if mh-compose-prompt-flag (mh-read-address prompt) ""))
731
732 (defun mh-interactive-read-string (prompt)
733 "Read a string.
734 If `mh-compose-prompt-flag' is non-nil, then read a string with
735 PROMPT.
736 Otherwise return the empty string."
737 (if mh-compose-prompt-flag (read-string prompt) ""))
738
670 ;;;###mh-autoload 739 ;;;###mh-autoload
671 (defun mh-send-other-window (to cc subject) 740 (defun mh-show-buffer-message-number (&optional buffer)
672 "Compose a message in another window. 741 "Message number of displayed message in corresponding show buffer.
673 742
674 See `mh-send' for more information and a description of how the 743 Return nil if show buffer not displayed.
675 TO, CC, and SUBJECT arguments are used." 744 If in `mh-letter-mode', don't display the message number being replied
676 (interactive (list 745 to, but rather the message number of the show buffer associated with
677 (mh-interactive-read-address "To: ") 746 our originating folder buffer.
678 (mh-interactive-read-address "Cc: ") 747 Optional argument BUFFER can be used to specify the buffer."
679 (mh-interactive-read-string "Subject: "))) 748 (save-excursion
680 (let ((pop-up-windows t)) 749 (if buffer
681 (mh-send-sub to cc subject (current-window-configuration)))) 750 (set-buffer buffer))
751 (cond ((eq major-mode 'mh-show-mode)
752 (let ((number-start (mh-search-from-end ?/ buffer-file-name)))
753 (string-to-number (substring buffer-file-name
754 (1+ number-start)))))
755 ((and (eq major-mode 'mh-folder-mode)
756 mh-show-buffer
757 (get-buffer mh-show-buffer))
758 (mh-show-buffer-message-number mh-show-buffer))
759 ((and (eq major-mode 'mh-letter-mode)
760 mh-sent-from-folder
761 (get-buffer mh-sent-from-folder))
762 (mh-show-buffer-message-number mh-sent-from-folder))
763 (t
764 nil))))
682 765
683 (defun mh-send-sub (to cc subject config) 766 (defun mh-send-sub (to cc subject config)
684 "Do the real work of composing and sending a letter. 767 "Do the real work of composing and sending a letter.
685 Expects the TO, CC, and SUBJECT fields as arguments. 768 Expects the TO, CC, and SUBJECT fields as arguments.
686 CONFIG is the window configuration before sending mail." 769 CONFIG is the window configuration before sending mail."
775 "Return the pathname of folder for draft messages." 858 "Return the pathname of folder for draft messages."
776 (save-excursion 859 (save-excursion
777 (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new") 860 (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
778 (buffer-substring (point-min) (1- (point-max))))) 861 (buffer-substring (point-min) (1- (point-max)))))
779 862
780 (defun mh-annotate-msg (msg buffer note &rest args)
781 "Mark MSG in BUFFER with character NOTE and annotate message with ARGS.
782 MSG can be a message number, a list of message numbers, or a
783 sequence."
784 (apply 'mh-exec-cmd "anno" buffer
785 (if (listp msg) (append msg args) (cons msg args)))
786 (save-excursion
787 (cond ((get-buffer buffer) ; Buffer may be deleted
788 (set-buffer buffer)
789 (mh-iterate-on-range nil msg
790 (mh-notate nil note
791 (+ mh-cmd-note mh-scan-field-destination-offset)))))))
792
793 (defun mh-insert-fields (&rest name-values) 863 (defun mh-insert-fields (&rest name-values)
794 "Insert the NAME-VALUES pairs in the current buffer. 864 "Insert the NAME-VALUES pairs in the current buffer.
795 If the field exists, append the value to it. 865 If the field exists, append the value to it.
796 Do not insert any pairs whose value is the empty string." 866 Do not insert any pairs whose value is the empty string."
797 (let ((case-fold-search t)) 867 (let ((case-fold-search t))
806 (insert " " (or value ""))) 876 (insert " " (or value "")))
807 (t 877 (t
808 (insert field-name " " value "\n"))) 878 (insert field-name " " value "\n")))
809 (setq name-values (cdr (cdr name-values))))))) 879 (setq name-values (cdr (cdr name-values)))))))
810 880
811 (defun mh-position-on-field (field &optional ignored) 881 (defun mh-compose-and-send-mail (draft send-args
812 "Move to the end of the FIELD in the header. 882 sent-from-folder sent-from-msg
813 Move to end of entire header if FIELD not found. 883 to subject cc
814 Returns non-nil iff FIELD was found. 884 annotate-char annotate-field
815 The optional second arg is for pre-version 4 compatibility and is 885 config)
816 IGNORED." 886 "Edit and compose a draft message in buffer DRAFT and send or save it.
817 (cond ((mh-goto-header-field field) 887 SEND-ARGS is the argument passed to the send command.
818 (mh-header-field-end) 888 SENT-FROM-FOLDER is buffer containing scan listing of current folder,
819 t) 889 or nil if none exists.
820 ((mh-goto-header-end 0) 890 SENT-FROM-MSG is the message number or sequence name or nil.
821 nil))) 891 The TO, SUBJECT, and CC fields are passed to the
822 892 `mh-compose-letter-function'.
823 ;;;###mh-autoload 893 If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of
824 (defun mh-get-header-field (field) 894 the message. In that case, the ANNOTATE-FIELD is used to build a
825 "Find and return the body of FIELD in the mail header. 895 string for `mh-annotate-msg'.
826 Returns the empty string if the field is not in the header of the 896 CONFIG is the window configuration to restore after sending the
827 current buffer." 897 letter."
828 (if (mh-goto-header-field field) 898 (pop-to-buffer draft)
829 (progn 899 (mh-letter-mode)
830 (skip-chars-forward " \t") ;strip leading white space in body 900
831 (let ((start (point))) 901 ;; Insert identity.
832 (mh-header-field-end) 902 (mh-insert-identity mh-identity-default t)
833 (buffer-substring-no-properties start (point)))) 903 (mh-identity-make-menu)
834 "")) 904 (mh-identity-add-menu)
835 905
836 (fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility 906 ;; Insert extra fields.
837 907 (mh-insert-x-mailer)
838 (defun mh-goto-header-field (field) 908 (mh-insert-x-face)
839 "Move to FIELD in the message header. 909
840 Move to the end of the FIELD name, which should end in a colon. 910 (mh-letter-hide-all-skipped-fields)
841 Returns t if found, nil if not." 911
842 (goto-char (point-min)) 912 (setq mh-sent-from-folder sent-from-folder)
843 (let ((case-fold-search t) 913 (setq mh-sent-from-msg sent-from-msg)
844 (headers-end (save-excursion 914 (setq mh-send-args send-args)
845 (mh-goto-header-end 0) 915 (setq mh-annotate-char annotate-char)
846 (point)))) 916 (setq mh-annotate-field annotate-field)
847 (re-search-forward (format "^%s" field) headers-end t))) 917 (setq mh-previous-window-config config)
848 918 (setq mode-line-buffer-identification (list " {%b}"))
849 (defun mh-goto-header-end (arg) 919 (mh-logo-display)
850 "Move the cursor ARG lines after the header." 920 (mh-make-local-hook 'kill-buffer-hook)
851 (if (re-search-forward "^-*$" nil nil) 921 (add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t)
852 (forward-line arg))) 922 (if (and (boundp 'mh-compose-letter-function)
853 923 mh-compose-letter-function)
854 (defun mh-extract-from-header-value () 924 ;; run-hooks will not pass arguments.
855 "Extract From: string from header." 925 (let ((value mh-compose-letter-function))
856 (save-excursion 926 (if (and (listp value) (not (eq (car value) 'lambda)))
857 (if (not (mh-goto-header-field "From:")) 927 (while value
858 nil 928 (funcall (car value) to subject cc)
859 (skip-chars-forward " \t") 929 (setq value (cdr value)))
860 (buffer-substring-no-properties 930 (funcall mh-compose-letter-function to subject cc)))))
861 (point) (progn (mh-header-field-end)(point))))))
862
863
864
865 ;;; Mode for composing and sending a draft message.
866
867 (defvar mh-pgp-support-flag (not (not (locate-library "mml2015")))
868 "Non-nil means PGP support is available.")
869
870 (put 'mh-letter-mode 'mode-class 'special)
871
872 ;; Menu extracted from mh-menubar.el V1.1 (31 July 2001)
873 (eval-when-compile (defvar mh-letter-menu nil))
874 (easy-menu-define
875 mh-letter-menu mh-letter-mode-map "Menu for MH-E letter mode."
876 '("Letter"
877 ["Send This Draft" mh-send-letter t]
878 ["Split Current Line" mh-open-line t]
879 ["Check Recipient" mh-check-whom t]
880 ["Yank Current Message" mh-yank-cur-msg t]
881 ["Insert a Message..." mh-insert-letter t]
882 ["Insert Signature" mh-insert-signature t]
883 ("Encrypt/Sign Message"
884 ["Sign Message"
885 mh-mml-secure-message-sign mh-pgp-support-flag]
886 ["Encrypt Message"
887 mh-mml-secure-message-encrypt mh-pgp-support-flag]
888 ["Sign+Encrypt Message"
889 mh-mml-secure-message-signencrypt mh-pgp-support-flag]
890 ["Disable Security"
891 mh-mml-unsecure-message mh-pgp-support-flag]
892 "--"
893 "Security Method"
894 ["PGP (MIME)" (setq mh-mml-method-default "pgpmime")
895 :style radio
896 :selected (equal mh-mml-method-default "pgpmime")]
897 ["PGP" (setq mh-mml-method-default "pgp")
898 :style radio
899 :selected (equal mh-mml-method-default "pgp")]
900 ["S/MIME" (setq mh-mml-method-default "smime")
901 :style radio
902 :selected (equal mh-mml-method-default "smime")]
903 "--"
904 ["Save Method as Default"
905 (customize-save-variable 'mh-mml-method-default mh-mml-method-default) t]
906 )
907 ["Compose Insertion..." mh-compose-insertion t]
908 ["Compose Compressed tar (MH)..."
909 mh-mh-compose-external-compressed-tar t]
910 ["Compose Get File (MH)..." mh-mh-compose-anon-ftp t]
911 ["Compose Forward..." mh-compose-forward t]
912 ;; The next two will have to be merged. But I also need to make sure the
913 ;; user can't mix tags of both types.
914 ["Pull in All Compositions (MH)"
915 mh-mh-to-mime (mh-mh-directive-present-p)]
916 ["Pull in All Compositions (MML)"
917 mh-mml-to-mime (mh-mml-tag-present-p)]
918 ["Revert to Non-MIME Edit (MH)"
919 mh-mh-to-mime-undo (equal mh-compose-insertion 'mh)]
920 ["Kill This Draft" mh-fully-kill-draft t]))
921
922
923
924 ;;; Help Messages
925
926 ;; Group messages logically, more or less.
927 (defvar mh-letter-mode-help-messages
928 '((nil
929 "Send letter: \\[mh-send-letter]"
930 "\t\tOpen line: \\[mh-open-line]\n"
931 "Kill letter: \\[mh-fully-kill-draft]"
932 "\t\tInsert:\n"
933 "Check recipients: \\[mh-check-whom]"
934 "\t\t Current message: \\[mh-yank-cur-msg]\n"
935 "\t\t Attachment: \\[mh-compose-insertion]\n"
936 "\t\t Message to forward: \\[mh-compose-forward]\n"
937 " "
938 "Security:"
939 "\t\t Encrypt message: \\[mh-mml-secure-message-encrypt]"
940 "\t\t Sign+Encrypt message: \\[mh-mml-secure-message-signencrypt]"
941 "\t\t Sign message: \\[mh-mml-secure-message-sign]\n"
942 " "
943 "\t\t Signature: \\[mh-insert-signature]"))
944 "Key binding cheat sheet.
945
946 This is an associative array which is used to show the most
947 common commands. The key is a prefix char. The value is one or
948 more strings which are concatenated together and displayed in the
949 minibuffer if ? is pressed after the prefix character. The
950 special key nil is used to display the non-prefixed commands.
951
952 The substitutions described in `substitute-command-keys' are
953 performed as well.")
954
955 ;; Shush compiler.
956 (eval-when-compile
957 (defvar adaptive-fill-first-line-regexp)
958 (defvar tool-bar-map))
959
960 (defvar mh-letter-buttons-init-flag nil)
961
962 ;;;###autoload
963 (define-derived-mode mh-letter-mode mail-mode "MH-Letter"
964 "Mode for composing letters in MH-E\\<mh-letter-mode-map>.
965
966 When you have finished composing, type \\[mh-send-letter] to send
967 the message using the MH mail handling system.
968
969 There are two types of tags used by MH-E when composing MIME
970 messages: MML and MH. The option `mh-compose-insertion' controls
971 what type of tags are inserted by MH-E commands. These tags can
972 be converted to MIME body parts by running \\[mh-mh-to-mime] for
973 MH-style directives or \\[mh-mml-to-mime] for MML tags.
974
975 Options that control this mode can be changed with
976 \\[customize-group]; specify the \"mh-compose\" group.
977
978 When a message is composed, the hooks `text-mode-hook',
979 `mail-mode-hook', and `mh-letter-mode-hook' are run (in that
980 order).
981
982 \\{mh-letter-mode-map}"
983 (mh-find-path)
984 (make-local-variable 'mh-send-args)
985 (make-local-variable 'mh-annotate-char)
986 (make-local-variable 'mh-annotate-field)
987 (make-local-variable 'mh-previous-window-config)
988 (make-local-variable 'mh-sent-from-folder)
989 (make-local-variable 'mh-sent-from-msg)
990 (mh-do-in-gnu-emacs
991 (unless mh-letter-buttons-init-flag
992 (mh-tool-bar-letter-buttons-init)
993 (setq mh-letter-buttons-init-flag t)))
994 ;; Set the local value of mh-mail-header-separator according to what is
995 ;; present in the buffer...
996 (set (make-local-variable 'mh-mail-header-separator)
997 (save-excursion
998 (goto-char (mh-mail-header-end))
999 (buffer-substring-no-properties (point) (line-end-position))))
1000 (make-local-variable 'mail-header-separator)
1001 (setq mail-header-separator mh-mail-header-separator) ;override sendmail.el
1002 (make-local-variable 'mh-help-messages)
1003 (setq mh-help-messages mh-letter-mode-help-messages)
1004 (setq buffer-invisibility-spec '((vanish . t) t))
1005 (set (make-local-variable 'line-move-ignore-invisible) t)
1006
1007 ;; Enable undo since a show-mode buffer might have been reused.
1008 (buffer-enable-undo)
1009 (set (make-local-variable 'tool-bar-map) mh-letter-tool-bar-map)
1010 (mh-funcall-if-exists mh-tool-bar-init :letter)
1011 (make-local-variable 'font-lock-defaults)
1012 (cond
1013 ((or (equal mh-highlight-citation-style 'font-lock)
1014 (equal mh-highlight-citation-style 'gnus))
1015 ;; Let's use font-lock even if gnus is used in show-mode. The reason
1016 ;; is that gnus uses static text properties which are not appropriate
1017 ;; for a buffer that will be edited. So the choice here is either fontify
1018 ;; the citations and header...
1019 (setq font-lock-defaults '(mh-letter-font-lock-keywords t)))
1020 (t
1021 ;; ...or the header only
1022 (setq font-lock-defaults '(mh-show-font-lock-keywords t))))
1023 (easy-menu-add mh-letter-menu)
1024 (setq fill-column mh-letter-fill-column)
1025 ;; If text-mode-hook turned on auto-fill, tune it for messages
1026 (when auto-fill-function
1027 (make-local-variable 'auto-fill-function)
1028 (setq auto-fill-function 'mh-auto-fill-for-letter)))
1029
1030 (defun mh-font-lock-field-data (limit)
1031 "Find header field region between point and LIMIT."
1032 (and (< (point) (mh-letter-header-end))
1033 (< (point) limit)
1034 (let ((end (min limit (mh-letter-header-end)))
1035 (point (point))
1036 data-end data-begin field)
1037 (end-of-line)
1038 (setq data-end (if (re-search-forward "^[^ \t]" end t)
1039 (match-beginning 0)
1040 end))
1041 (goto-char (1- data-end))
1042 (if (not (re-search-backward "\\(^[^ \t][^:]*\\):[ \t]*" nil t))
1043 (setq data-begin (point-min))
1044 (setq data-begin (match-end 0))
1045 (setq field (match-string 1)))
1046 (setq data-begin (max point data-begin))
1047 (goto-char (if (equal point data-end) (1+ data-end) data-end))
1048 (cond ((and field (mh-letter-skipped-header-field-p field))
1049 (set-match-data nil)
1050 nil)
1051 (t (set-match-data
1052 (list data-begin data-end data-begin data-end))
1053 t)))))
1054
1055 (defun mh-letter-header-end ()
1056 "Find the end of the message header.
1057 This function is to be used only for font locking. It works by
1058 searching for `mh-mail-header-separator' in the buffer."
1059 (save-excursion
1060 (goto-char (point-min))
1061 (cond ((equal mh-mail-header-separator "") (point-min))
1062 ((search-forward (format "\n%s\n" mh-mail-header-separator) nil t)
1063 (line-beginning-position 0))
1064 (t (point-min)))))
1065
1066 (defun mh-auto-fill-for-letter ()
1067 "Perform auto-fill for message.
1068 Header is treated specially by inserting a tab before continuation
1069 lines."
1070 (if (mh-in-header-p)
1071 (let ((fill-prefix "\t"))
1072 (do-auto-fill))
1073 (do-auto-fill)))
1074
1075 (defun mh-insert-header-separator ()
1076 "Insert `mh-mail-header-separator', if absent."
1077 (save-excursion
1078 (goto-char (point-min))
1079 (rfc822-goto-eoh)
1080 (if (looking-at "$")
1081 (insert mh-mail-header-separator))))
1082
1083 ;;;###mh-autoload
1084 (defun mh-to-field ()
1085 "Move to specified header field.
1086
1087 The field is indicated by the previous keystroke (the last
1088 keystroke of the command) according to the list in the variable
1089 `mh-to-field-choices'.
1090 Create the field if it does not exist.
1091 Set the mark to point before moving."
1092 (interactive)
1093 (expand-abbrev)
1094 (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
1095 mh-to-field-choices)
1096 ;; also look for a char for version 4 compat
1097 (assoc (logior last-input-char ?`)
1098 mh-to-field-choices))))
1099 (case-fold-search t))
1100 (push-mark)
1101 (cond ((mh-position-on-field target)
1102 (let ((eol (point)))
1103 (skip-chars-backward " \t")
1104 (delete-region (point) eol))
1105 (if (and (not (eq (logior last-input-char ?`) ?s))
1106 (save-excursion
1107 (backward-char 1)
1108 (not (looking-at "[:,]"))))
1109 (insert ", ")
1110 (insert " ")))
1111 (t
1112 (if (mh-position-on-field "To:")
1113 (forward-line 1))
1114 (insert (format "%s \n" target))
1115 (backward-char 1)))))
1116
1117 ;;;###mh-autoload
1118 (defun mh-to-fcc (&optional folder)
1119 "Move to \"Fcc:\" header field.
1120
1121 This command will prompt you for the FOLDER name in which to file
1122 a copy of the draft."
1123 (interactive (list (mh-prompt-for-folder
1124 "Fcc"
1125 (or (and mh-default-folder-for-message-function
1126 (save-excursion
1127 (goto-char (point-min))
1128 (funcall
1129 mh-default-folder-for-message-function)))
1130 "")
1131 t)))
1132 (let ((last-input-char ?\C-f))
1133 (expand-abbrev)
1134 (save-excursion
1135 (mh-to-field)
1136 (insert (if (mh-folder-name-p folder)
1137 (substring folder 1)
1138 folder)))))
1139
1140 (defun mh-file-is-vcard-p (file)
1141 "Return t if FILE is a .vcf vcard."
1142 (let ((case-fold-search t))
1143 (and (stringp file)
1144 (file-exists-p file)
1145 (or (and (not (mh-have-file-command))
1146 (not (null (string-match "\.vcf$" file))))
1147 (string-equal "text/x-vcard" (mh-file-mime-type file))))))
1148
1149 ;;;###mh-autoload
1150 (defun mh-insert-signature (&optional file)
1151 "Insert signature in message.
1152
1153 This command inserts your signature at the current cursor location.
1154
1155 By default, the text of your signature is taken from the file
1156 \"~/.signature\". You can read from other sources by changing the
1157 option `mh-signature-file-name'.
1158
1159 A signature separator (\"-- \") will be added if the signature block
1160 does not contain one and `mh-signature-separator-flag' is on.
1161
1162 The hook `mh-insert-signature-hook' is run after the signature is
1163 inserted. Hook functions may access the actual name of the file or the
1164 function used to insert the signature with `mh-signature-file-name'.
1165
1166 The signature can also be inserted using Identities (see
1167 `mh-identity-list').
1168
1169 In a program, you can pass in a signature FILE."
1170 (interactive)
1171 (save-excursion
1172 (insert "\n")
1173 (let ((mh-signature-file-name (or file mh-signature-file-name))
1174 (mh-mh-p (mh-mh-directive-present-p))
1175 (mh-mml-p (mh-mml-tag-present-p)))
1176 (save-restriction
1177 (narrow-to-region (point) (point))
1178 (cond
1179 ((mh-file-is-vcard-p mh-signature-file-name)
1180 (if (equal mh-compose-insertion 'mml)
1181 (insert "<#part type=\"text/x-vcard\" filename=\""
1182 mh-signature-file-name
1183 "\" disposition=inline description=VCard>\n<#/part>")
1184 (insert "#text/x-vcard; name=\""
1185 (file-name-nondirectory mh-signature-file-name)
1186 "\" [VCard] " (expand-file-name mh-signature-file-name))))
1187 (t
1188 (cond
1189 (mh-mh-p
1190 (insert "#\n" "Content-Description: Signature\n"))
1191 (mh-mml-p
1192 (mml-insert-tag 'part 'type "text/plain" 'disposition "inline"
1193 'description "Signature")))
1194 (cond ((null mh-signature-file-name))
1195 ((and (stringp mh-signature-file-name)
1196 (file-readable-p mh-signature-file-name))
1197 (insert-file-contents mh-signature-file-name))
1198 ((functionp mh-signature-file-name)
1199 (funcall mh-signature-file-name)))))
1200 (save-restriction
1201 (widen)
1202 (run-hooks 'mh-insert-signature-hook))
1203 (goto-char (point-min))
1204 (when (and (not (mh-file-is-vcard-p mh-signature-file-name))
1205 mh-signature-separator-flag
1206 (> (point-max) (point-min))
1207 (not (mh-signature-separator-p)))
1208 (cond (mh-mh-p
1209 (forward-line 2))
1210 (mh-mml-p
1211 (forward-line 1)))
1212 (insert mh-signature-separator))
1213 (if (not (> (point-max) (point-min)))
1214 (message "No signature found")))))
1215 (force-mode-line-update))
1216
1217 ;;;###mh-autoload
1218 (defun mh-check-whom ()
1219 "Verify recipients, showing expansion of any aliases.
1220
1221 This command expands aliases so you can check the actual address(es)
1222 in the alias. A new buffer named \"*MH-E Recipients*\" is created with
1223 the output of \"whom\"."
1224 (interactive)
1225 (let ((file-name buffer-file-name))
1226 (save-buffer)
1227 (message "Checking recipients...")
1228 (mh-in-show-buffer (mh-recipients-buffer)
1229 (bury-buffer (current-buffer))
1230 (erase-buffer)
1231 (mh-exec-cmd-output "whom" t file-name))
1232 (message "Checking recipients...done")))
1233
1234 (defun mh-tidy-draft-buffer ()
1235 "Run when a draft buffer is destroyed."
1236 (let ((buffer (get-buffer mh-recipients-buffer)))
1237 (if buffer
1238 (kill-buffer buffer))))
1239
1240
1241
1242 ;;; Routines to compose and send a letter.
1243
1244 (defun mh-insert-x-face ()
1245 "Append X-Face, Face or X-Image-URL field to header.
1246 If the field already exists, this function does nothing."
1247 (when (and (file-exists-p mh-x-face-file)
1248 (file-readable-p mh-x-face-file))
1249 (save-excursion
1250 (unless (or (mh-position-on-field "X-Face")
1251 (mh-position-on-field "Face")
1252 (mh-position-on-field "X-Image-URL"))
1253 (save-excursion
1254 (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
1255 (if (not (looking-at "^"))
1256 (insert "\n")))
1257 (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ")
1258 (insert "X-Face: "))))))
1259
1260 (defvar mh-x-mailer-string nil
1261 "*String containing the contents of the X-Mailer header field.
1262 If nil, this variable is initialized to show the version of MH-E,
1263 Emacs, and MH the first time a message is composed.")
1264 931
1265 (defun mh-insert-x-mailer () 932 (defun mh-insert-x-mailer ()
1266 "Append an X-Mailer field to the header. 933 "Append an X-Mailer field to the header.
1267 The versions of MH-E, Emacs, and MH are shown." 934 The versions of MH-E, Emacs, and MH are shown."
1268 ;; Lazily initialize mh-x-mailer-string. 935 ;; Lazily initialize mh-x-mailer-string.
1281 (save-excursion 948 (save-excursion
1282 (when (and mh-insert-x-mailer-flag 949 (when (and mh-insert-x-mailer-flag
1283 (null (mh-goto-header-field "X-Mailer"))) 950 (null (mh-goto-header-field "X-Mailer")))
1284 (mh-insert-fields "X-Mailer:" mh-x-mailer-string)))) 951 (mh-insert-fields "X-Mailer:" mh-x-mailer-string))))
1285 952
1286 (defun mh-regexp-in-field-p (regexp &rest fields) 953 (defun mh-insert-x-face ()
1287 "Non-nil means REGEXP was found in FIELDS." 954 "Append X-Face, Face or X-Image-URL field to header.
955 If the field already exists, this function does nothing."
956 (when (and (file-exists-p mh-x-face-file)
957 (file-readable-p mh-x-face-file))
958 (save-excursion
959 (unless (or (mh-position-on-field "X-Face")
960 (mh-position-on-field "Face")
961 (mh-position-on-field "X-Image-URL"))
962 (save-excursion
963 (goto-char (+ (point) (cadr (insert-file-contents mh-x-face-file))))
964 (if (not (looking-at "^"))
965 (insert "\n")))
966 (unless (looking-at "\\(X-Face\\|Face\\|X-Image-URL\\): ")
967 (insert "X-Face: "))))))
968
969 ;;;###mh-autoload
970 (defun mh-letter-hide-all-skipped-fields ()
971 "Hide all skipped fields."
1288 (save-excursion 972 (save-excursion
1289 (let ((search-result nil) 973 (goto-char (point-min))
1290 (field)) 974 (save-restriction
1291 (while fields 975 (narrow-to-region (point) (mh-mail-header-end))
1292 (setq field (car fields)) 976 (while (re-search-forward mh-letter-header-field-regexp nil t)
1293 (if (and (mh-goto-header-field field) 977 (if (mh-letter-skipped-header-field-p (match-string 1))
1294 (re-search-forward 978 (mh-letter-toggle-header-field-display -1)
1295 regexp (save-excursion (mh-header-field-end)(point)) t)) 979 (mh-letter-toggle-header-field-display 'long))
1296 (setq fields nil 980 (beginning-of-line 2)))))
1297 search-result t) 981
1298 (setq fields (cdr fields)))) 982 (defun mh-tidy-draft-buffer ()
1299 search-result))) 983 "Run when a draft buffer is destroyed."
984 (let ((buffer (get-buffer mh-recipients-buffer)))
985 (if buffer
986 (kill-buffer buffer))))
987
988 (defun mh-letter-mode-message ()
989 "Display a help message for users of `mh-letter-mode'.
990 This should be the last function called when composing the draft."
991 (message "%s" (substitute-command-keys
992 (concat "Type \\[mh-send-letter] to send message, "
993 "\\[mh-help] for help"))))
994
995 (defun mh-letter-adjust-point ()
996 "Move cursor to first header field if are using the no prompt mode."
997 (unless mh-compose-prompt-flag
998 (goto-char (point-max))
999 (mh-letter-next-header-field)))
1000
1001 (defun mh-annotate-msg (msg buffer note &rest args)
1002 "Mark MSG in BUFFER with character NOTE and annotate message with ARGS.
1003 MSG can be a message number, a list of message numbers, or a
1004 sequence."
1005 (apply 'mh-exec-cmd "anno" buffer
1006 (if (listp msg) (append msg args) (cons msg args)))
1007 (save-excursion
1008 (cond ((get-buffer buffer) ; Buffer may be deleted
1009 (set-buffer buffer)
1010 (mh-iterate-on-range nil msg
1011 (mh-notate nil note
1012 (+ mh-cmd-note mh-scan-field-destination-offset)))))))
1013
1014 ;;;###mh-autoload
1015 (defun mh-get-header-field (field)
1016 "Find and return the body of FIELD in the mail header.
1017 Returns the empty string if the field is not in the header of the
1018 current buffer."
1019 (if (mh-goto-header-field field)
1020 (progn
1021 (skip-chars-forward " \t") ;strip leading white space in body
1022 (let ((start (point)))
1023 (mh-header-field-end)
1024 (buffer-substring-no-properties start (point))))
1025 ""))
1026
1027 (fset 'mh-get-field 'mh-get-header-field) ;MH-E 4 compatibility
1028
1029 (defun mh-insert-header-separator ()
1030 "Insert `mh-mail-header-separator', if absent."
1031 (save-excursion
1032 (goto-char (point-min))
1033 (rfc822-goto-eoh)
1034 (if (looking-at "$")
1035 (insert mh-mail-header-separator))))
1300 1036
1301 ;;;###mh-autoload 1037 ;;;###mh-autoload
1302 (defun mh-insert-auto-fields (&optional non-interactive) 1038 (defun mh-insert-auto-fields (&optional non-interactive)
1303 "Insert custom fields if recipient is found in `mh-auto-fields-list'. 1039 "Insert custom fields if recipient is found in `mh-auto-fields-list'.
1304 1040
1330 (while entry-list 1066 (while entry-list
1331 (let ((field (caar entry-list)) 1067 (let ((field (caar entry-list))
1332 (value (cdar entry-list))) 1068 (value (cdar entry-list)))
1333 (cond 1069 (cond
1334 ((equal ":identity" field) 1070 ((equal ":identity" field)
1335 (when ;;(and (not mh-identity-local) 1071 (when
1072 ;;(and (not mh-identity-local)
1336 ;; Bug 1204506. But do we need to be able 1073 ;; Bug 1204506. But do we need to be able
1337 ;; to set an identity manually that won't be 1074 ;; to set an identity manually that won't be
1338 ;; overridden by mh-insert-auto-fields? 1075 ;; overridden by mh-insert-auto-fields?
1339 (assoc value mh-identity-list) 1076 (assoc value mh-identity-list)
1340 ;;) 1077 ;;)
1341 (mh-insert-identity value))) 1078 (mh-insert-identity value)))
1342 (t 1079 (t
1343 (mh-modify-header-field field value 1080 (mh-modify-header-field field value
1344 (equal field "From"))))) 1081 (equal field "From")))))
1345 (setq entry-list (cdr entry-list)))))) 1082 (setq entry-list (cdr entry-list))))))
1363 (insert " " value ",")) 1100 (insert " " value ","))
1364 (t 1101 (t
1365 (mh-goto-header-end 0) 1102 (mh-goto-header-end 0)
1366 (insert field ": " value "\n")))) 1103 (insert field ": " value "\n"))))
1367 1104
1368 (defun mh-compose-and-send-mail (draft send-args 1105 (defun mh-regexp-in-field-p (regexp &rest fields)
1369 sent-from-folder sent-from-msg 1106 "Non-nil means REGEXP was found in FIELDS."
1370 to subject cc 1107 (save-excursion
1371 annotate-char annotate-field 1108 (let ((search-result nil)
1372 config) 1109 (field))
1373 "Edit and compose a draft message in buffer DRAFT and send or save it. 1110 (while fields
1374 SEND-ARGS is the argument passed to the send command. 1111 (setq field (car fields))
1375 SENT-FROM-FOLDER is buffer containing scan listing of current folder, 1112 (if (and (mh-goto-header-field field)
1376 or nil if none exists. 1113 (re-search-forward
1377 SENT-FROM-MSG is the message number or sequence name or nil. 1114 regexp (save-excursion (mh-header-field-end)(point)) t))
1378 The TO, SUBJECT, and CC fields are passed to the 1115 (setq fields nil
1379 `mh-compose-letter-function'. 1116 search-result t)
1380 If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of 1117 (setq fields (cdr fields))))
1381 the message. In that case, the ANNOTATE-FIELD is used to build a 1118 search-result)))
1382 string for `mh-annotate-msg'.
1383 CONFIG is the window configuration to restore after sending the
1384 letter."
1385 (pop-to-buffer draft)
1386 (mh-letter-mode)
1387
1388 ;; Insert identity.
1389 (if (and (boundp 'mh-identity-default)
1390 mh-identity-default
1391 (not mh-identity-local))
1392 (mh-insert-identity mh-identity-default))
1393 (mh-identity-make-menu)
1394 (easy-menu-add mh-identity-menu)
1395
1396 ;; Insert extra fields.
1397 (mh-insert-x-mailer)
1398 (mh-insert-x-face)
1399
1400 (mh-letter-hide-all-skipped-fields)
1401
1402 (setq mh-sent-from-folder sent-from-folder)
1403 (setq mh-sent-from-msg sent-from-msg)
1404 (setq mh-send-args send-args)
1405 (setq mh-annotate-char annotate-char)
1406 (setq mh-annotate-field annotate-field)
1407 (setq mh-previous-window-config config)
1408 (setq mode-line-buffer-identification (list " {%b}"))
1409 (mh-logo-display)
1410 (mh-make-local-hook 'kill-buffer-hook)
1411 (add-hook 'kill-buffer-hook 'mh-tidy-draft-buffer nil t)
1412 (if (and (boundp 'mh-compose-letter-function)
1413 mh-compose-letter-function)
1414 ;; run-hooks will not pass arguments.
1415 (let ((value mh-compose-letter-function))
1416 (if (and (listp value) (not (eq (car value) 'lambda)))
1417 (while value
1418 (funcall (car value) to subject cc)
1419 (setq value (cdr value)))
1420 (funcall mh-compose-letter-function to subject cc)))))
1421
1422 (defun mh-letter-mode-message ()
1423 "Display a help message for users of `mh-letter-mode'.
1424 This should be the last function called when composing the draft."
1425 (message "%s" (substitute-command-keys
1426 (concat "Type \\[mh-send-letter] to send message, "
1427 "\\[mh-help] for help"))))
1428 1119
1429 (defun mh-ascii-buffer-p () 1120 (defun mh-ascii-buffer-p ()
1430 "Check if current buffer is entirely composed of ASCII. 1121 "Check if current buffer is entirely composed of ASCII.
1431 The function doesn't work for XEmacs since `find-charset-region' 1122 The function doesn't work for XEmacs since `find-charset-region'
1432 doesn't exist there." 1123 doesn't exist there."
1433 (loop for charset in (mh-funcall-if-exists 1124 (loop for charset in (mh-funcall-if-exists
1434 find-charset-region (point-min) (point-max)) 1125 find-charset-region (point-min) (point-max))
1435 unless (eq charset 'ascii) return nil 1126 unless (eq charset 'ascii) return nil
1436 finally return t)) 1127 finally return t))
1437 1128
1438 ;; Shush compiler.
1439 (eval-when-compile (defvar sendmail-coding-system))
1440
1441 ;;;###mh-autoload
1442 (defun mh-send-letter (&optional arg)
1443 "Save draft and send message.
1444
1445 When you are all through editing a message, you send it with this
1446 command. You can give a prefix argument ARG to monitor the first stage
1447 of the delivery\; this output can be found in a buffer called \"*MH-E
1448 Mail Delivery*\".
1449
1450 The hook `mh-before-send-letter-hook' is run at the beginning of
1451 this command. For example, if you want to check your spelling in
1452 your message before sending, add the function `ispell-message'.
1453
1454 In case the MH \"send\" program is installed under a different name,
1455 use `mh-send-prog' to tell MH-E the name."
1456 (interactive "P")
1457 (run-hooks 'mh-before-send-letter-hook)
1458 (if (and (mh-insert-auto-fields t)
1459 mh-auto-fields-prompt-flag
1460 (goto-char (point-min)))
1461 (if (not (y-or-n-p "Auto fields inserted, send? "))
1462 (error "Send aborted")))
1463 (cond ((mh-mh-directive-present-p)
1464 (mh-mh-to-mime))
1465 ((or (mh-mml-tag-present-p) (not (mh-ascii-buffer-p)))
1466 (mh-mml-to-mime)))
1467 (save-buffer)
1468 (message "Sending...")
1469 (let ((draft-buffer (current-buffer))
1470 (file-name buffer-file-name)
1471 (config mh-previous-window-config)
1472 (coding-system-for-write
1473 (if (and (local-variable-p 'buffer-file-coding-system
1474 (current-buffer)) ;XEmacs needs two args
1475 ;; We're not sure why, but buffer-file-coding-system
1476 ;; tends to get set to undecided-unix.
1477 (not (memq buffer-file-coding-system
1478 '(undecided undecided-unix undecided-dos))))
1479 buffer-file-coding-system
1480 (or (and (boundp 'sendmail-coding-system) sendmail-coding-system)
1481 (and (boundp 'default-buffer-file-coding-system )
1482 default-buffer-file-coding-system)
1483 'iso-latin-1))))
1484 ;; Adding a Message-ID field looks good, makes it easier to search for
1485 ;; message in your +outbox, and best of all doesn't break threading for
1486 ;; the recipient if you reply to a message in your +outbox.
1487 (setq mh-send-args (concat "-msgid " mh-send-args))
1488 ;; The default BCC encapsulation will make a MIME message unreadable.
1489 ;; With nmh use the -mime arg to prevent this.
1490 (if (and (mh-variant-p 'nmh)
1491 (mh-goto-header-field "Bcc:")
1492 (mh-goto-header-field "Content-Type:"))
1493 (setq mh-send-args (concat "-mime " mh-send-args)))
1494 (cond (arg
1495 (pop-to-buffer mh-mail-delivery-buffer)
1496 (erase-buffer)
1497 (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
1498 "-nodraftfolder" mh-send-args file-name)
1499 (goto-char (point-max)) ; show the interesting part
1500 (recenter -1)
1501 (set-buffer draft-buffer)) ; for annotation below
1502 (t
1503 (mh-exec-cmd-daemon mh-send-prog nil "-nodraftfolder" "-noverbose"
1504 mh-send-args file-name)))
1505 (if mh-annotate-char
1506 (mh-annotate-msg mh-sent-from-msg
1507 mh-sent-from-folder
1508 mh-annotate-char
1509 "-component" mh-annotate-field
1510 "-text" (format "\"%s %s\""
1511 (mh-get-header-field "To:")
1512 (mh-get-header-field "Cc:"))))
1513
1514 (cond ((or (not arg)
1515 (y-or-n-p "Kill draft buffer? "))
1516 (kill-buffer draft-buffer)
1517 (if config
1518 (set-window-configuration config))))
1519 (if arg
1520 (message "Sending...done")
1521 (message "Sending...backgrounded"))))
1522
1523 ;;;###mh-autoload
1524 (defun mh-insert-letter (folder message verbatim)
1525 "Insert a message.
1526
1527 This command prompts you for the FOLDER and MESSAGE number, which
1528 defaults to the current message in that folder. It then inserts
1529 the message, indented by `mh-ins-buf-prefix' (\"> \") unless
1530 `mh-yank-behavior' is set to one of the supercite flavors in
1531 which case supercite is used to format the message. Certain
1532 undesirable header fields (see
1533 `mh-invisible-header-fields-compiled') are removed before
1534 insertion.
1535
1536 If given a prefix argument VERBATIM, the header is left intact, the
1537 message is not indented, and \"> \" is not inserted before each line.
1538 This command leaves the mark before the letter and point after it."
1539 (interactive
1540 (let* ((folder
1541 (mh-prompt-for-folder "Message from"
1542 mh-sent-from-folder nil))
1543 (default
1544 (if (and (equal folder mh-sent-from-folder)
1545 (numberp mh-sent-from-msg))
1546 mh-sent-from-msg
1547 (nth 0 (mh-translate-range folder "cur"))))
1548 (message
1549 (read-string (concat "Message number"
1550 (or (and default
1551 (format " (default %d): " default))
1552 ": ")))))
1553 (list folder message current-prefix-arg)))
1554 (save-restriction
1555 (narrow-to-region (point) (point))
1556 (let ((start (point-min)))
1557 (if (and (equal message "") (numberp mh-sent-from-msg))
1558 (setq message (int-to-string mh-sent-from-msg)))
1559 (insert-file-contents
1560 (expand-file-name message (mh-expand-file-name folder)))
1561 (when (not verbatim)
1562 (mh-clean-msg-header start mh-invisible-header-fields-compiled nil)
1563 (goto-char (point-max)) ;Needed for sc-cite-original
1564 (push-mark) ;Needed for sc-cite-original
1565 (goto-char (point-min)) ;Needed for sc-cite-original
1566 (mh-insert-prefix-string mh-ins-buf-prefix)))))
1567
1568 (defun mh-extract-from-attribution ()
1569 "Extract phrase or comment from From header field."
1570 (save-excursion
1571 (if (not (mh-goto-header-field "From: "))
1572 nil
1573 (skip-chars-forward " ")
1574 (cond
1575 ((looking-at "\"\\([^\"\n]+\\)\" \\(<.+>\\)")
1576 (format "%s %s " (match-string 1)(match-string 2)))
1577 ((looking-at "\\([^<\n]+<.+>\\)$")
1578 (format "%s " (match-string 1)))
1579 ((looking-at "\\([^ ]+@[^ ]+\\) +(\\(.+\\))$")
1580 (format "%s <%s> " (match-string 2)(match-string 1)))
1581 ((looking-at " *\\(.+\\)$")
1582 (format "%s " (match-string 1)))))))
1583
1584 ;;;###mh-autoload
1585 (defun mh-yank-cur-msg ()
1586 "Insert the current message into the draft buffer.
1587
1588 It is often useful to insert a snippet of text from a letter that
1589 someone mailed to provide some context for your reply. This
1590 command does this by adding an attribution, yanking a portion of
1591 text from the message to which you're replying, and inserting
1592 `mh-ins-buf-prefix' (`> ') before each line.
1593
1594 The attribution consists of the sender's name and email address
1595 followed by the content of the option
1596 `mh-extract-from-attribution-verb'.
1597
1598 You can also turn on the option
1599 `mh-delete-yanked-msg-window-flag' to delete the window
1600 containing the original message after yanking it to make more
1601 room on your screen for your reply.
1602
1603 You can control how the message to which you are replying is
1604 yanked into your reply using `mh-yank-behavior'.
1605
1606 If this isn't enough, you can gain full control over the
1607 appearance of the included text by setting `mail-citation-hook'
1608 to a function that modifies it. For example, if you set this hook
1609 to `trivial-cite' (which is NOT part of Emacs), set
1610 `mh-yank-behavior' to \"Body and Header\" (see URL
1611 `http://shasta.cs.uiuc.edu/~lrclause/tc.html').
1612
1613 Note that if `mail-citation-hook' is set, `mh-ins-buf-prefix' is
1614 not inserted. If the option `mh-yank-behavior' is set to one of
1615 the supercite flavors, the hook `mail-citation-hook' is ignored
1616 and `mh-ins-buf-prefix' is not inserted."
1617 (interactive)
1618 (if (and mh-sent-from-folder
1619 (save-excursion (set-buffer mh-sent-from-folder) mh-show-buffer)
1620 (save-excursion (set-buffer mh-sent-from-folder)
1621 (get-buffer mh-show-buffer))
1622 mh-sent-from-msg)
1623 (let ((to-point (point))
1624 (to-buffer (current-buffer)))
1625 (set-buffer mh-sent-from-folder)
1626 (if mh-delete-yanked-msg-window-flag
1627 (delete-windows-on mh-show-buffer))
1628 (set-buffer mh-show-buffer) ; Find displayed message
1629 (let* ((from-attr (mh-extract-from-attribution))
1630 (yank-region (mh-mark-active-p nil))
1631 (mh-ins-str
1632 (cond ((and yank-region
1633 (or (eq 'supercite mh-yank-behavior)
1634 (eq 'autosupercite mh-yank-behavior)
1635 (eq t mh-yank-behavior)))
1636 ;; supercite needs the full header
1637 (concat
1638 (buffer-substring (point-min) (mh-mail-header-end))
1639 "\n"
1640 (buffer-substring (region-beginning) (region-end))))
1641 (yank-region
1642 (buffer-substring (region-beginning) (region-end)))
1643 ((or (eq 'body mh-yank-behavior)
1644 (eq 'attribution mh-yank-behavior)
1645 (eq 'autoattrib mh-yank-behavior))
1646 (buffer-substring
1647 (save-excursion
1648 (goto-char (point-min))
1649 (mh-goto-header-end 1)
1650 (point))
1651 (point-max)))
1652 ((or (eq 'supercite mh-yank-behavior)
1653 (eq 'autosupercite mh-yank-behavior)
1654 (eq t mh-yank-behavior))
1655 (buffer-substring (point-min) (point-max)))
1656 (t
1657 (buffer-substring (point) (point-max))))))
1658 (set-buffer to-buffer)
1659 (save-restriction
1660 (narrow-to-region to-point to-point)
1661 (insert (mh-filter-out-non-text mh-ins-str))
1662 (goto-char (point-max)) ;Needed for sc-cite-original
1663 (push-mark) ;Needed for sc-cite-original
1664 (goto-char (point-min)) ;Needed for sc-cite-original
1665 (mh-insert-prefix-string mh-ins-buf-prefix)
1666 (when (or (eq 'attribution mh-yank-behavior)
1667 (eq 'autoattrib mh-yank-behavior))
1668 (insert from-attr)
1669 (mh-identity-insert-attribution-verb nil)
1670 (insert "\n\n"))
1671 ;; If the user has selected a region, he has already "edited" the
1672 ;; text, so leave the cursor at the end of the yanked text. In
1673 ;; either case, leave a mark at the opposite end of the included
1674 ;; text to make it easy to jump or delete to the other end of the
1675 ;; text.
1676 (push-mark)
1677 (goto-char (point-max))
1678 (if (null yank-region)
1679 (mh-exchange-point-and-mark-preserving-active-mark)))))
1680 (error "There is no current message")))
1681
1682 (defun mh-filter-out-non-text (string)
1683 "Return STRING but without adornments such as MIME buttons and smileys."
1684 (with-temp-buffer
1685 ;; Insert the string to filter
1686 (insert string)
1687 (goto-char (point-min))
1688
1689 ;; Remove the MIME buttons
1690 (let ((can-move-forward t)
1691 (in-button nil))
1692 (while can-move-forward
1693 (cond ((and (not (get-text-property (point) 'mh-data))
1694 in-button)
1695 (delete-region (1- (point)) (point))
1696 (setq in-button nil))
1697 ((get-text-property (point) 'mh-data)
1698 (delete-region (point)
1699 (save-excursion (forward-line) (point)))
1700 (setq in-button t))
1701 (t (setq can-move-forward (= (forward-line) 0))))))
1702
1703 ;; Return the contents without properties... This gets rid of emphasis
1704 ;; and smileys
1705 (buffer-substring-no-properties (point-min) (point-max))))
1706
1707 (defun mh-insert-prefix-string (mh-ins-string)
1708 "Insert prefix string before each line in buffer.
1709 The inserted letter is cited using `sc-cite-original' if
1710 `mh-yank-behavior' is one of 'supercite or 'autosupercite.
1711 Otherwise, simply insert MH-INS-STRING before each line."
1712 (goto-char (point-min))
1713 (cond ((or (eq mh-yank-behavior 'supercite)
1714 (eq mh-yank-behavior 'autosupercite))
1715 (sc-cite-original))
1716 (mail-citation-hook
1717 (run-hooks 'mail-citation-hook))
1718 (mh-yank-hooks ;old hook name
1719 (run-hooks 'mh-yank-hooks))
1720 (t
1721 (or (bolp) (forward-line 1))
1722 (while (< (point) (point-max))
1723 (insert mh-ins-string)
1724 (forward-line 1))
1725 (goto-char (point-min))))) ;leave point like sc-cite-original
1726
1727 ;;;###mh-autoload
1728 (defun mh-fully-kill-draft ()
1729 "Quit editing and delete draft message.
1730
1731 If for some reason you are not happy with the draft, you can use
1732 this command to kill the draft buffer and delete the draft
1733 message. Use the command \\[kill-buffer] if you don't want to
1734 delete the draft message."
1735 (interactive)
1736 (if (y-or-n-p "Kill draft message? ")
1737 (let ((config mh-previous-window-config))
1738 (if (file-exists-p buffer-file-name)
1739 (delete-file buffer-file-name))
1740 (set-buffer-modified-p nil)
1741 (kill-buffer (buffer-name))
1742 (message "")
1743 (if config
1744 (set-window-configuration config)))
1745 (error "Message not killed")))
1746
1747 (defun mh-current-fill-prefix ()
1748 "Return the `fill-prefix' on the current line as a string."
1749 (save-excursion
1750 (beginning-of-line)
1751 ;; This assumes that the major-mode sets up adaptive-fill-regexp
1752 ;; correctly such as mh-letter-mode or sendmail.el's mail-mode. But
1753 ;; perhaps I should use the variable and simply inserts its value here,
1754 ;; and set it locally in a let scope. --psg
1755 (if (re-search-forward adaptive-fill-regexp nil t)
1756 (match-string 0)
1757 "")))
1758
1759 ;;;###mh-autoload
1760 (defun mh-open-line ()
1761 "Insert a newline and leave point before it.
1762
1763 This command is similar to the command \\[open-line] in that it
1764 inserts a newline after point. It differs in that it also inserts
1765 the right number of quoting characters and spaces so that the
1766 next line begins in the same column as it was. This is useful
1767 when breaking up paragraphs in replies."
1768 (interactive)
1769 (let ((column (current-column))
1770 (prefix (mh-current-fill-prefix)))
1771 (if (> (length prefix) column)
1772 (message "Sorry, point seems to be within the line prefix")
1773 (newline 2)
1774 (insert prefix)
1775 (while (> column (current-column))
1776 (insert " "))
1777 (forward-line -1))))
1778
1779 (mh-do-in-xemacs (defvar mail-abbrevs))
1780
1781 (defmacro mh-display-completion-list-compat (word choices)
1782 "Completes WORD from CHOICES using `display-completion-list'.
1783 Calls `display-completion-list' correctly in older environments.
1784 Versions of Emacs prior to version 22 lacked a COMMON-SUBSTRING
1785 argument which is used to highlight the next possible character you
1786 can enter in the current list of completions."
1787 (if (>= emacs-major-version 22)
1788 `(display-completion-list (all-completions ,word ,choices) ,word)
1789 `(display-completion-list (all-completions ,word ,choices))))
1790
1791 ;;;###mh-autoload
1792 (defun mh-complete-word (word choices begin end)
1793 "Complete WORD at from CHOICES.
1794 Any match found replaces the text from BEGIN to END."
1795 (let ((completion (try-completion word choices))
1796 (completions-buffer "*Completions*"))
1797 (cond ((eq completion t)
1798 (ignore-errors
1799 (kill-buffer completions-buffer))
1800 (message "Completed: %s" word))
1801 ((null completion)
1802 (ignore-errors
1803 (kill-buffer completions-buffer))
1804 (message "No completion for %s" word))
1805 ((stringp completion)
1806 (if (equal word completion)
1807 (with-output-to-temp-buffer completions-buffer
1808 (mh-display-completion-list-compat word choices))
1809 (ignore-errors
1810 (kill-buffer completions-buffer))
1811 (delete-region begin end)
1812 (insert completion))))))
1813
1814 ;;;###mh-autoload
1815 (defun mh-beginning-of-word (&optional n)
1816 "Return position of the N th word backwards."
1817 (unless n (setq n 1))
1818 (let ((syntax-table (syntax-table)))
1819 (unwind-protect
1820 (save-excursion
1821 (mh-mail-abbrev-make-syntax-table)
1822 (set-syntax-table mail-abbrev-syntax-table)
1823 (backward-word n)
1824 (point))
1825 (set-syntax-table syntax-table))))
1826
1827 (defun mh-folder-expand-at-point ()
1828 "Do folder name completion in Fcc header field."
1829 (let* ((end (point))
1830 (beg (mh-beginning-of-word))
1831 (folder (buffer-substring beg end))
1832 (leading-plus (and (> (length folder) 0) (equal (aref folder 0) ?+)))
1833 (last-slash (mh-search-from-end ?/ folder))
1834 (prefix (and last-slash (substring folder 0 last-slash)))
1835 (choices (mapcar #'(lambda (x)
1836 (list (cond (prefix (format "%s/%s" prefix x))
1837 (leading-plus (format "+%s" x))
1838 (t x))))
1839 (mh-folder-completion-function folder nil t))))
1840 (mh-complete-word folder choices beg end)))
1841
1842 (defvar mh-letter-complete-function-alist
1843 '((bcc . mh-alias-letter-expand-alias)
1844 (cc . mh-alias-letter-expand-alias)
1845 (dcc . mh-alias-letter-expand-alias)
1846 (fcc . mh-folder-expand-at-point)
1847 (from . mh-alias-letter-expand-alias)
1848 (mail-followup-to . mh-alias-letter-expand-alias)
1849 (mail-reply-to . mh-alias-letter-expand-alias)
1850 (reply-to . mh-alias-letter-expand-alias)
1851 (to . mh-alias-letter-expand-alias))
1852 "Alist of header fields and completion functions to use.")
1853
1854 (defun mh-letter-complete (arg)
1855 "Perform completion on header field or word preceding point.
1856
1857 If the field contains addresses (for example, \"To:\" or \"Cc:\")
1858 or folders (for example, \"Fcc:\") then this command will provide
1859 alias completion. In the body of the message, this command runs
1860 `mh-letter-complete-function' instead, which is set to
1861 `ispell-complete-word' by default. This command takes a prefix
1862 argument ARG that is passed to the
1863 `mh-letter-complete-function'."
1864 (interactive "P")
1865 (let ((func nil))
1866 (cond ((not (mh-in-header-p))
1867 (funcall mh-letter-complete-function arg))
1868 ((setq func (cdr (assoc (mh-letter-header-field-at-point)
1869 mh-letter-complete-function-alist)))
1870 (funcall func))
1871 (t (funcall mh-letter-complete-function arg)))))
1872
1873 (defun mh-letter-complete-or-space (arg)
1874 "Perform completion or insert space.
1875
1876 Turn on the option `mh-compose-space-does-completion-flag' to use
1877 this command to perform completion in the header. Otherwise, a
1878 space is inserted; use a prefix argument ARG to specify more than
1879 one space."
1880 (interactive "p")
1881 (let ((func nil)
1882 (end-of-prev (save-excursion
1883 (goto-char (mh-beginning-of-word))
1884 (mh-beginning-of-word -1))))
1885 (cond ((not mh-compose-space-does-completion-flag)
1886 (self-insert-command arg))
1887 ((not (mh-in-header-p)) (self-insert-command arg))
1888 ((> (point) end-of-prev) (self-insert-command arg))
1889 ((setq func (cdr (assoc (mh-letter-header-field-at-point)
1890 mh-letter-complete-function-alist)))
1891 (funcall func))
1892 (t (self-insert-command arg)))))
1893
1894 (defun mh-letter-confirm-address ()
1895 "Flash alias expansion.
1896
1897 Addresses are separated by a comma\; when you press the comma,
1898 this command flashes the alias expansion in the minibuffer if
1899 `mh-alias-flash-on-comma' is turned on."
1900 (interactive)
1901 (cond ((not (mh-in-header-p)) (self-insert-command 1))
1902 ((eq (cdr (assoc (mh-letter-header-field-at-point)
1903 mh-letter-complete-function-alist))
1904 'mh-alias-letter-expand-alias)
1905 (mh-alias-reload-maybe)
1906 (mh-alias-minibuffer-confirm-address))
1907 (t (self-insert-command 1))))
1908
1909 (defvar mh-letter-header-field-regexp "^\\([A-Za-z][A-Za-z0-9-]*\\):")
1910
1911 (defun mh-letter-header-field-at-point ()
1912 "Return the header field name at point.
1913 A symbol is returned whose name is the string obtained by
1914 downcasing the field name."
1915 (save-excursion
1916 (end-of-line)
1917 (and (re-search-backward mh-letter-header-field-regexp nil t)
1918 (intern (downcase (match-string 1))))))
1919
1920 ;;;###mh-autoload
1921 (defun mh-letter-next-header-field-or-indent (arg)
1922 "Cycle to next field.
1923
1924 Within the header of the message, this command moves between
1925 fields that are highlighted with the face
1926 `mh-letter-header-field', skipping those fields listed in
1927 `mh-compose-skipped-header-fields'. After the last field, this
1928 command then moves point to the message body before cycling back
1929 to the first field. If point is already past the first line of
1930 the message body, then this command indents by calling
1931 `indent-relative' with the given prefix argument ARG."
1932 (interactive "P")
1933 (let ((header-end (save-excursion
1934 (goto-char (mh-mail-header-end))
1935 (forward-line)
1936 (point))))
1937 (if (> (point) header-end)
1938 (indent-relative arg)
1939 (mh-letter-next-header-field))))
1940
1941 (defun mh-letter-next-header-field ()
1942 "Cycle to the next header field.
1943 If we are at the last header field go to the start of the message
1944 body."
1945 (let ((header-end (mh-mail-header-end)))
1946 (cond ((>= (point) header-end) (goto-char (point-min)))
1947 ((< (point) (progn
1948 (beginning-of-line)
1949 (re-search-forward mh-letter-header-field-regexp
1950 (line-end-position) t)
1951 (point)))
1952 (beginning-of-line))
1953 (t (end-of-line)))
1954 (cond ((re-search-forward mh-letter-header-field-regexp header-end t)
1955 (if (mh-letter-skipped-header-field-p (match-string 1))
1956 (mh-letter-next-header-field)
1957 (mh-letter-skip-leading-whitespace-in-header-field)))
1958 (t (goto-char header-end)
1959 (forward-line)))))
1960
1961 ;;;###mh-autoload
1962 (defun mh-letter-previous-header-field ()
1963 "Cycle to the previous header field.
1964
1965 This command moves backwards between the fields and cycles to the
1966 body of the message after the first field. Unlike the command
1967 \\[mh-letter-next-header-field-or-indent], it will always take
1968 point to the last field from anywhere in the body."
1969 (interactive)
1970 (let ((header-end (mh-mail-header-end)))
1971 (if (>= (point) header-end)
1972 (goto-char header-end)
1973 (mh-header-field-beginning))
1974 (cond ((re-search-backward mh-letter-header-field-regexp nil t)
1975 (if (mh-letter-skipped-header-field-p (match-string 1))
1976 (mh-letter-previous-header-field)
1977 (goto-char (match-end 0))
1978 (mh-letter-skip-leading-whitespace-in-header-field)))
1979 (t (goto-char header-end)
1980 (forward-line)))))
1981
1982 (defun mh-letter-skipped-header-field-p (field)
1983 "Check if FIELD is to be skipped."
1984 (let ((field (downcase field)))
1985 (loop for x in mh-compose-skipped-header-fields
1986 when (equal (downcase x) field) return t
1987 finally return nil)))
1988
1989 (defun mh-letter-skip-leading-whitespace-in-header-field ()
1990 "Skip leading whitespace in a header field.
1991 If the header field doesn't have at least one space after the
1992 colon then a space character is added."
1993 (let ((need-space t))
1994 (while (memq (char-after) '(?\t ?\ ))
1995 (forward-char)
1996 (setq need-space nil))
1997 (when need-space (insert " "))))
1998
1999 (defvar mh-hidden-header-keymap
2000 (let ((map (make-sparse-keymap)))
2001 (mh-do-in-gnu-emacs
2002 (define-key map [mouse-2] 'mh-letter-toggle-header-field-display-button))
2003 (mh-do-in-xemacs
2004 (define-key map '(button2)
2005 'mh-letter-toggle-header-field-display-button))
2006 map))
2007
2008 (defun mh-letter-toggle-header-field-display-button (event)
2009 "Toggle header field display at location of EVENT.
2010 This function does the same thing as
2011 `mh-letter-toggle-header-field-display' except that it is
2012 callable from a mouse button."
2013 (interactive "e")
2014 (mh-do-at-event-location event
2015 (mh-letter-toggle-header-field-display nil)))
2016
2017 (defun mh-letter-toggle-header-field-display (arg)
2018 "Toggle display of header field at point.
2019
2020 Use this command to display truncated header fields. This command
2021 is a toggle so entering it again will hide the field. This
2022 command takes a prefix argument ARG: if negative then the field
2023 is hidden, if positive then the field is displayed."
2024 (interactive (list nil))
2025 (when (and (mh-in-header-p)
2026 (progn
2027 (end-of-line)
2028 (re-search-backward mh-letter-header-field-regexp nil t)))
2029 (let ((buffer-read-only nil)
2030 (modified-flag (buffer-modified-p))
2031 (begin (point))
2032 end)
2033 (end-of-line)
2034 (setq end (1- (if (re-search-forward "^[^ \t]" nil t)
2035 (match-beginning 0)
2036 (point-max))))
2037 (goto-char begin)
2038 ;; Make it clickable...
2039 (add-text-properties begin end `(keymap ,mh-hidden-header-keymap
2040 mouse-face highlight))
2041 (unwind-protect
2042 (cond ((or (and (not arg)
2043 (text-property-any begin end 'invisible 'vanish))
2044 (and (numberp arg) (>= arg 0))
2045 (and (eq arg 'long) (> (line-beginning-position 5) end)))
2046 (remove-text-properties begin end '(invisible nil))
2047 (search-forward ":" (line-end-position) t)
2048 (mh-letter-skip-leading-whitespace-in-header-field))
2049 ;; XXX Redesign to make usable by user. Perhaps use a positive
2050 ;; numeric prefix to make that many lines visible.
2051 ((eq arg 'long)
2052 (end-of-line 4)
2053 (mh-letter-truncate-header-field end)
2054 (beginning-of-line))
2055 (t (end-of-line)
2056 (mh-letter-truncate-header-field end)
2057 (beginning-of-line)))
2058 (set-buffer-modified-p modified-flag)))))
2059
2060 (defun mh-letter-truncate-header-field (end)
2061 "Replace text from current line till END with an ellipsis.
2062 If the current line is too long truncate a part of it as well."
2063 (let ((max-len (min (window-width) 62)))
2064 (when (> (+ (current-column) 4) max-len)
2065 (backward-char (- (+ (current-column) 5) max-len)))
2066 (when (> end (point))
2067 (add-text-properties (point) end '(invisible vanish)))))
2068
2069 (defun mh-letter-hide-all-skipped-fields ()
2070 "Hide all skipped fields."
2071 (save-excursion
2072 (goto-char (point-min))
2073 (save-restriction
2074 (narrow-to-region (point) (mh-mail-header-end))
2075 (while (re-search-forward mh-letter-header-field-regexp nil t)
2076 (if (mh-letter-skipped-header-field-p (match-string 1))
2077 (mh-letter-toggle-header-field-display -1)
2078 (mh-letter-toggle-header-field-display 'long))
2079 (beginning-of-line 2)))))
2080
2081 (defun mh-interactive-read-address (prompt)
2082 "Read an address.
2083 If `mh-compose-prompt-flag' is non-nil, then read an address with
2084 PROMPT.
2085 Otherwise return the empty string."
2086 (if mh-compose-prompt-flag (mh-read-address prompt) ""))
2087
2088 (defun mh-interactive-read-string (prompt)
2089 "Read a string.
2090 If `mh-compose-prompt-flag' is non-nil, then read a string with
2091 PROMPT.
2092 Otherwise return the empty string."
2093 (if mh-compose-prompt-flag (read-string prompt) ""))
2094
2095 (defun mh-letter-adjust-point ()
2096 "Move cursor to first header field if are using the no prompt mode."
2097 (unless mh-compose-prompt-flag
2098 (goto-char (point-max))
2099 (mh-letter-next-header-field)))
2100
2101
2102
2103 ;;; Build mh-letter-mode keymap
2104
2105 ;; If this changes, modify mh-letter-mode-help-messages accordingly, above.
2106 (gnus-define-keys mh-letter-mode-map
2107 " " mh-letter-complete-or-space
2108 "," mh-letter-confirm-address
2109 "\C-c?" mh-help
2110 "\C-c\C-\\" mh-fully-kill-draft ;if no C-q
2111 "\C-c\C-^" mh-insert-signature ;if no C-s
2112 "\C-c\C-c" mh-send-letter
2113 "\C-c\C-d" mh-insert-identity
2114 "\C-c\C-e" mh-mh-to-mime
2115 "\C-c\C-f\C-a" mh-to-field
2116 "\C-c\C-f\C-b" mh-to-field
2117 "\C-c\C-f\C-c" mh-to-field
2118 "\C-c\C-f\C-d" mh-to-field
2119 "\C-c\C-f\C-f" mh-to-fcc
2120 "\C-c\C-f\C-l" mh-to-field
2121 "\C-c\C-f\C-m" mh-to-field
2122 "\C-c\C-f\C-r" mh-to-field
2123 "\C-c\C-f\C-s" mh-to-field
2124 "\C-c\C-f\C-t" mh-to-field
2125 "\C-c\C-fa" mh-to-field
2126 "\C-c\C-fb" mh-to-field
2127 "\C-c\C-fc" mh-to-field
2128 "\C-c\C-fd" mh-to-field
2129 "\C-c\C-ff" mh-to-fcc
2130 "\C-c\C-fl" mh-to-field
2131 "\C-c\C-fm" mh-to-field
2132 "\C-c\C-fr" mh-to-field
2133 "\C-c\C-fs" mh-to-field
2134 "\C-c\C-ft" mh-to-field
2135 "\C-c\C-i" mh-insert-letter
2136 "\C-c\C-m\C-e" mh-mml-secure-message-encrypt
2137 "\C-c\C-m\C-f" mh-compose-forward
2138 "\C-c\C-m\C-g" mh-mh-compose-anon-ftp
2139 "\C-c\C-m\C-i" mh-compose-insertion
2140 "\C-c\C-m\C-m" mh-mml-to-mime
2141 "\C-c\C-m\C-n" mh-mml-unsecure-message
2142 "\C-c\C-m\C-s" mh-mml-secure-message-sign
2143 "\C-c\C-m\C-t" mh-mh-compose-external-compressed-tar
2144 "\C-c\C-m\C-u" mh-mh-to-mime-undo
2145 "\C-c\C-m\C-x" mh-mh-compose-external-type
2146 "\C-c\C-mee" mh-mml-secure-message-encrypt
2147 "\C-c\C-mes" mh-mml-secure-message-signencrypt
2148 "\C-c\C-mf" mh-compose-forward
2149 "\C-c\C-mg" mh-mh-compose-anon-ftp
2150 "\C-c\C-mi" mh-compose-insertion
2151 "\C-c\C-mm" mh-mml-to-mime
2152 "\C-c\C-mn" mh-mml-unsecure-message
2153 "\C-c\C-mse" mh-mml-secure-message-signencrypt
2154 "\C-c\C-mss" mh-mml-secure-message-sign
2155 "\C-c\C-mt" mh-mh-compose-external-compressed-tar
2156 "\C-c\C-mu" mh-mh-to-mime-undo
2157 "\C-c\C-mx" mh-mh-compose-external-type
2158 "\C-c\C-o" mh-open-line
2159 "\C-c\C-q" mh-fully-kill-draft
2160 "\C-c\C-s" mh-insert-signature
2161 "\C-c\C-t" mh-letter-toggle-header-field-display
2162 "\C-c\C-w" mh-check-whom
2163 "\C-c\C-y" mh-yank-cur-msg
2164 "\C-c\M-d" mh-insert-auto-fields
2165 "\M-\t" mh-letter-complete
2166 "\t" mh-letter-next-header-field-or-indent
2167 [backtab] mh-letter-previous-header-field)
2168
2169 ;; "C-c /" prefix is used in mh-letter-mode by pgp.el and mailcrypt.el.
2170
2171 (provide 'mh-comp) 1129 (provide 'mh-comp)
2172 1130
2173 ;; Local Variables: 1131 ;; Local Variables:
2174 ;; indent-tabs-mode: nil 1132 ;; indent-tabs-mode: nil
2175 ;; sentence-end-double-space: nil 1133 ;; sentence-end-double-space: nil