Mercurial > emacs
comparison lisp/mh-e/mh-utils.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 | 1052cc7b7d7f |
children | 0f44616074ba |
comparison
equal
deleted
inserted
replaced
68464:79464a6167f5 | 68465:37d03b3298bf |
---|---|
1 ;;; mh-utils.el --- MH-E code needed for both sending and reading | 1 ;;; mh-utils.el --- MH-E general utilities |
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. | |
31 | |
32 ;;; Change Log: | 30 ;;; Change Log: |
33 | 31 |
34 ;;; Code: | 32 ;;; Code: |
35 | 33 |
36 ;;(message "> mh-utils") | 34 (require 'mh-e) |
37 (eval-and-compile | |
38 (defvar recursive-load-depth-limit) | |
39 (if (and (boundp 'recursive-load-depth-limit) | |
40 (integerp recursive-load-depth-limit) | |
41 (< recursive-load-depth-limit 50)) | |
42 (setq recursive-load-depth-limit 50))) | |
43 | |
44 (eval-when-compile (require 'mh-acros)) | |
45 (mh-require-cl) | 35 (mh-require-cl) |
46 | 36 |
47 (require 'font-lock) | 37 (require 'font-lock) |
48 (require 'gnus-util) | |
49 (require 'mh-buffers) | |
50 (require 'mh-customize) | |
51 (require 'mh-inc) | |
52 (require 'mouse) | |
53 (require 'sendmail) | |
54 ;;(message "< mh-utils") | |
55 | |
56 ;; Non-fatal dependencies | |
57 (load "hl-line" t t) | |
58 (load "mm-decode" t t) | |
59 (load "mm-view" t t) | |
60 (load "tool-bar" t t) | |
61 (load "vcard" t t) | |
62 | |
63 | |
64 | |
65 ;;; Autoloads | |
66 | |
67 (autoload 'gnus-article-highlight-citation "gnus-cite") | |
68 (autoload 'message-fetch-field "message") | |
69 (autoload 'message-tokenize-header "message") | |
70 (unless (fboundp 'make-hash-table) | |
71 (autoload 'make-hash-table "cl")) | |
72 | |
73 | |
74 | 38 |
75 ;;; CL Replacements | 39 ;;; CL Replacements |
76 | 40 |
41 ;;;###mh-autoload | |
77 (defun mh-search-from-end (char string) | 42 (defun mh-search-from-end (char string) |
78 "Return the position of last occurrence of CHAR in STRING. | 43 "Return the position of last occurrence of CHAR in STRING. |
79 If CHAR is not present in STRING then return nil. The function is | 44 If CHAR is not present in STRING then return nil. The function is |
80 used in lieu of `search' in the CL package." | 45 used in lieu of `search' in the CL package." |
81 (loop for index from (1- (length string)) downto 0 | 46 (loop for index from (1- (length string)) downto 0 |
82 when (equal (aref string index) char) return index | 47 when (equal (aref string index) char) return index |
83 finally return nil)) | 48 finally return nil)) |
84 | 49 |
85 ;; Additional header fields that might someday be added: | |
86 ;; "Sender: " "Reply-to: " | |
87 | |
88 | 50 |
89 | 51 |
90 ;;; Scan Line Formats | 52 ;;; General Utilities |
91 | 53 |
92 (defvar mh-scan-msg-number-regexp "^ *\\([0-9]+\\)" | 54 (require 'mailabbrev nil t) |
93 "This regular expression extracts the message number. | 55 (mh-defun-compat mail-abbrev-make-syntax-table () |
94 | 56 "Emacs 21 and XEmacs don't have this function." |
95 It must match from the beginning of the line. Note that the | 57 nil) |
96 message number must be placed in a parenthesized expression as in | 58 |
97 the default of \"^ *\\\\([0-9]+\\\\)\".") | 59 ;;;###mh-autoload |
98 | 60 (defun mh-beginning-of-word (&optional n) |
99 (defvar mh-scan-msg-overflow-regexp "^[?0-9][0-9]" | 61 "Return position of the N th word backwards." |
100 "This regular expression matches overflowed message numbers.") | 62 (unless n (setq n 1)) |
101 | 63 (let ((syntax-table (syntax-table))) |
102 (defvar mh-scan-msg-format-regexp "%\\([0-9]*\\)(msg)" | 64 (unwind-protect |
103 "This regular expression finds the message number width in a scan format. | 65 (save-excursion |
104 | 66 (mail-abbrev-make-syntax-table) |
105 Note that the message number must be placed in a parenthesized | 67 (set-syntax-table mail-abbrev-syntax-table) |
106 expression as in the default of \"%\\\\([0-9]*\\\\)(msg)\". This | 68 (backward-word n) |
107 variable is only consulted if `mh-scan-format-file' is set to | 69 (point)) |
108 \"Use MH-E scan Format\".") | 70 (set-syntax-table syntax-table)))) |
109 | 71 |
110 (defvar mh-scan-msg-format-string "%d" | 72 ;;;###mh-autoload |
111 "This is a format string for width of the message number in a scan format. | 73 (defun mh-colors-available-p () |
112 | 74 "Check if colors are available in the Emacs being used." |
113 Use \"0%d\" for zero-filled message numbers. This variable is only | 75 (or mh-xemacs-flag |
114 consulted if `mh-scan-format-file' is set to \"Use MH-E scan | 76 (let ((color-cells (display-color-cells))) |
115 Format\".") | 77 (and (numberp color-cells) (>= color-cells 8))))) |
116 | 78 |
117 (defvar mh-scan-msg-search-regexp "^[^0-9]*%d[^0-9]" | 79 ;;;###mh-autoload |
118 "This regular expression matches a particular message. | 80 (defun mh-colors-in-use-p () |
119 | 81 "Check if colors are being used in the folder buffer." |
120 It is a format string; use \"%d\" to represent the location of the | 82 (and mh-colors-available-flag font-lock-mode)) |
121 message number within the expression as in the default of | 83 |
122 \"^[^0-9]*%d[^0-9]\".") | 84 ;;;###mh-autoload |
123 | 85 (defun mh-delete-line (lines) |
124 (defvar mh-cmd-note 4 | 86 "Delete the next LINES lines." |
125 "Column for notations. | 87 (delete-region (point) (progn (forward-line lines) (point)))) |
126 | 88 |
127 This variable should be set with the function `mh-set-cmd-note'. | 89 (defvar mh-image-load-path-called-flag nil) |
128 This variable may be updated dynamically if | 90 |
129 `mh-adaptive-cmd-note-flag' is on. | 91 ;;;###mh-autoload |
130 | 92 (defun mh-image-load-path () |
131 Note that columns in Emacs start with 0.") | 93 "Ensure that the MH-E images are accessible by `find-image'. |
132 (make-variable-buffer-local 'mh-cmd-note) | 94 Images for MH-E are found in ../../etc/images relative to the |
133 | 95 files in \"lisp/mh-e\". If `image-load-path' exists (since Emacs |
134 (defvar mh-note-seq ?% | 96 22), then the images directory is added to it if isn't already |
135 "Messages in a user-defined sequence are marked by this character. | 97 there. Otherwise, the images directory is added to the |
136 | 98 `load-path' if it isn't already there." |
137 Messages in the \"search\" sequence are marked by this character as | 99 (unless mh-image-load-path-called-flag |
138 well.") | 100 (let (mh-library-name mh-image-load-path) |
101 ;; First, find mh-e in the load-path. | |
102 (setq mh-library-name (locate-library "mh-e")) | |
103 (if (not mh-library-name) | |
104 (error "Can not find MH-E in load-path")) | |
105 (setq mh-image-load-path | |
106 (expand-file-name (concat (file-name-directory mh-library-name) | |
107 "../../etc/images"))) | |
108 (if (not (file-exists-p mh-image-load-path)) | |
109 (error "Can not find image directory %s" mh-image-load-path)) | |
110 (if (boundp 'image-load-path) | |
111 (add-to-list 'image-load-path mh-image-load-path) | |
112 (add-to-list 'load-path mh-image-load-path))) | |
113 (setq mh-image-load-path-called-flag t))) | |
114 | |
115 ;;;###mh-autoload | |
116 (defun mh-make-local-vars (&rest pairs) | |
117 "Initialize local variables according to the variable-value PAIRS." | |
118 (while pairs | |
119 (set (make-local-variable (car pairs)) (car (cdr pairs))) | |
120 (setq pairs (cdr (cdr pairs))))) | |
121 | |
122 ;;;###mh-autoload | |
123 (defun mh-mapc (function list) | |
124 "Apply FUNCTION to each element of LIST for side effects only." | |
125 (while list | |
126 (funcall function (car list)) | |
127 (setq list (cdr list)))) | |
128 | |
129 ;;;###mh-autoload | |
130 (defun mh-replace-string (old new) | |
131 "Replace all occurrences of OLD with NEW in the current buffer. | |
132 Ignores case when searching for OLD." | |
133 (goto-char (point-min)) | |
134 (let ((case-fold-search t)) | |
135 (while (search-forward old nil t) | |
136 (replace-match new t t)))) | |
139 | 137 |
140 | 138 |
141 | 139 |
142 (defvar mh-show-buffer-mode-line-buffer-id " {show-%s} %d" | 140 ;;; Logo Display |
143 "Format string to produce `mode-line-buffer-identification' for show buffers. | |
144 | |
145 First argument is folder name. Second is message number.") | |
146 | |
147 | |
148 | |
149 (defvar mh-mail-header-separator "--------" | |
150 "*Line used by MH to separate headers from text in messages being composed. | |
151 | |
152 This variable should not be used directly in programs. Programs | |
153 should use `mail-header-separator' instead. | |
154 `mail-header-separator' is initialized to | |
155 `mh-mail-header-separator' in `mh-letter-mode'; in other | |
156 contexts, you may have to perform this initialization yourself. | |
157 | |
158 Do not make this a regular expression as it may be the argument | |
159 to `insert' and it is passed through `regexp-quote' before being | |
160 used by functions like `re-search-forward'.") | |
161 | |
162 (defvar mh-signature-separator-regexp "^-- $" | |
163 "This regular expression matches the signature separator. | |
164 See `mh-signature-separator'.") | |
165 | |
166 (defvar mh-signature-separator "-- \n" | |
167 "Text of a signature separator. | |
168 | |
169 A signature separator is used to separate the body of a message | |
170 from the signature. This can be used by user agents such as MH-E | |
171 to render the signature differently or to suppress the inclusion | |
172 of the signature in a reply. Use `mh-signature-separator-regexp' | |
173 when searching for a separator.") | |
174 | |
175 (defun mh-signature-separator-p () | |
176 "Return non-nil if buffer includes \"^-- $\"." | |
177 (save-excursion | |
178 (goto-char (point-min)) | |
179 (re-search-forward mh-signature-separator-regexp nil t))) | |
180 | |
181 ;; Variables for MIME display | |
182 | |
183 ;; Structure to keep track of MIME handles on a per buffer basis. | |
184 (mh-defstruct (mh-buffer-data (:conc-name mh-mime-) | |
185 (:constructor mh-make-buffer-data)) | |
186 (handles ()) ; List of MIME handles | |
187 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of | |
188 ; nested messages | |
189 (parts-count 0) ; The button number is generated from | |
190 ; this number | |
191 (part-index-hash (make-hash-table))) ; Avoid incrementing the part number | |
192 ; for nested messages | |
193 | |
194 ;; This has to be a macro, since we do: (setf (mh-buffer-data) ...) | |
195 (defmacro mh-buffer-data () | |
196 "Convenience macro to get the MIME data structures of the current buffer." | |
197 `(gethash (current-buffer) mh-globals-hash)) | |
198 | |
199 (defvar mh-globals-hash (make-hash-table) | |
200 "Keeps track of MIME data on a per buffer basis.") | |
201 | |
202 (defvar mh-mm-inline-media-tests | |
203 `(("image/jpeg" | |
204 mm-inline-image | |
205 (lambda (handle) | |
206 (mm-valid-and-fit-image-p 'jpeg handle))) | |
207 ("image/png" | |
208 mm-inline-image | |
209 (lambda (handle) | |
210 (mm-valid-and-fit-image-p 'png handle))) | |
211 ("image/gif" | |
212 mm-inline-image | |
213 (lambda (handle) | |
214 (mm-valid-and-fit-image-p 'gif handle))) | |
215 ("image/tiff" | |
216 mm-inline-image | |
217 (lambda (handle) | |
218 (mm-valid-and-fit-image-p 'tiff handle)) ) | |
219 ("image/xbm" | |
220 mm-inline-image | |
221 (lambda (handle) | |
222 (mm-valid-and-fit-image-p 'xbm handle))) | |
223 ("image/x-xbitmap" | |
224 mm-inline-image | |
225 (lambda (handle) | |
226 (mm-valid-and-fit-image-p 'xbm handle))) | |
227 ("image/xpm" | |
228 mm-inline-image | |
229 (lambda (handle) | |
230 (mm-valid-and-fit-image-p 'xpm handle))) | |
231 ("image/x-pixmap" | |
232 mm-inline-image | |
233 (lambda (handle) | |
234 (mm-valid-and-fit-image-p 'xpm handle))) | |
235 ("image/bmp" | |
236 mm-inline-image | |
237 (lambda (handle) | |
238 (mm-valid-and-fit-image-p 'bmp handle))) | |
239 ("image/x-portable-bitmap" | |
240 mm-inline-image | |
241 (lambda (handle) | |
242 (mm-valid-and-fit-image-p 'pbm handle))) | |
243 ("text/plain" mm-inline-text identity) | |
244 ("text/enriched" mm-inline-text identity) | |
245 ("text/richtext" mm-inline-text identity) | |
246 ("text/x-patch" mm-display-patch-inline | |
247 (lambda (handle) | |
248 (locate-library "diff-mode"))) | |
249 ("application/emacs-lisp" mm-display-elisp-inline identity) | |
250 ("application/x-emacs-lisp" mm-display-elisp-inline identity) | |
251 ("text/html" | |
252 ,(if (fboundp 'mm-inline-text-html) 'mm-inline-text-html 'mm-inline-text) | |
253 (lambda (handle) | |
254 (or (and (boundp 'mm-inline-text-html-renderer) | |
255 mm-inline-text-html-renderer) | |
256 (and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))) | |
257 ("text/x-vcard" | |
258 mm-inline-text-vcard | |
259 (lambda (handle) | |
260 (or (featurep 'vcard) | |
261 (locate-library "vcard")))) | |
262 ("message/delivery-status" mm-inline-text identity) | |
263 ("message/rfc822" mh-mm-inline-message identity) | |
264 ;;("message/partial" mm-inline-partial identity) | |
265 ;;("message/external-body" mm-inline-external-body identity) | |
266 ("text/.*" mm-inline-text identity) | |
267 ("audio/wav" mm-inline-audio | |
268 (lambda (handle) | |
269 (and (or (featurep 'nas-sound) (featurep 'native-sound)) | |
270 (device-sound-enabled-p)))) | |
271 ("audio/au" | |
272 mm-inline-audio | |
273 (lambda (handle) | |
274 (and (or (featurep 'nas-sound) (featurep 'native-sound)) | |
275 (device-sound-enabled-p)))) | |
276 ("application/pgp-signature" ignore identity) | |
277 ("application/x-pkcs7-signature" ignore identity) | |
278 ("application/pkcs7-signature" ignore identity) | |
279 ("application/x-pkcs7-mime" ignore identity) | |
280 ("application/pkcs7-mime" ignore identity) | |
281 ("multipart/alternative" ignore identity) | |
282 ("multipart/mixed" ignore identity) | |
283 ("multipart/related" ignore identity) | |
284 ;; Disable audio and image | |
285 ("audio/.*" ignore ignore) | |
286 ("image/.*" ignore ignore) | |
287 ;; Default to displaying as text | |
288 (".*" mm-inline-text mm-readable-p)) | |
289 "Alist of media types/tests saying whether types can be displayed inline.") | |
290 | |
291 ;; Copy of `goto-address-mail-regexp' | |
292 (defvar mh-address-mail-regexp | |
293 "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+" | |
294 "A regular expression probably matching an e-mail address.") | |
295 | |
296 ;; From goto-addr.el, which we don't want to force-load on users. | |
297 | |
298 (defun mh-goto-address-find-address-at-point () | |
299 "Find e-mail address around or before point. | |
300 | |
301 Then search backwards to beginning of line for the start of an | |
302 e-mail address. If no e-mail address found, return nil." | |
303 (re-search-backward "[^-_A-z0-9.@]" (line-beginning-position) 'lim) | |
304 (if (or (looking-at mh-address-mail-regexp) ; already at start | |
305 (and (re-search-forward mh-address-mail-regexp | |
306 (line-end-position) 'lim) | |
307 (goto-char (match-beginning 0)))) | |
308 (match-string-no-properties 0))) | |
309 | |
310 (defun mh-mail-header-end () | |
311 "Substitute for `mail-header-end' that doesn't widen the buffer. | |
312 | |
313 In MH-E we frequently need to find the end of headers in nested | |
314 messages, where the buffer has been narrowed. This function works | |
315 in this situation." | |
316 (save-excursion | |
317 ;; XXX: The following replaces a call to rfc822-goto-eoh. Occasionally, | |
318 ;; mail headers that MH-E has to read contains lines of the form: | |
319 ;; From xxx@yyy Mon May 10 11:48:07 2004 | |
320 ;; In this situation, rfc822-goto-eoh doesn't go to the end of the | |
321 ;; header. The replacement allows From_ lines in the mail header. | |
322 (goto-char (point-min)) | |
323 (loop for p = (re-search-forward | |
324 "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move) | |
325 do (cond ((null p) (return)) | |
326 (t (goto-char (match-beginning 0)) | |
327 (unless (looking-at "From ") (return)) | |
328 (goto-char p)))) | |
329 (point))) | |
330 | |
331 (defun mh-in-header-p () | |
332 "Return non-nil if the point is in the header of a draft message." | |
333 (< (point) (mh-mail-header-end))) | |
334 | |
335 (defun mh-header-field-beginning () | |
336 "Move to the beginning of the current header field. | |
337 Handles RFC 822 continuation lines." | |
338 (beginning-of-line) | |
339 (while (looking-at "^[ \t]") | |
340 (forward-line -1))) | |
341 | |
342 (defun mh-header-field-end () | |
343 "Move to the end of the current header field. | |
344 Handles RFC 822 continuation lines." | |
345 (forward-line 1) | |
346 (while (looking-at "^[ \t]") | |
347 (forward-line 1)) | |
348 (backward-char 1)) ;to end of previous line | |
349 | |
350 (defun mh-letter-header-font-lock (limit) | |
351 "Return the entire mail header to font-lock. | |
352 Argument LIMIT limits search." | |
353 (if (= (point) limit) | |
354 nil | |
355 (let* ((mail-header-end (save-match-data (mh-mail-header-end))) | |
356 (lesser-limit (if (< mail-header-end limit) mail-header-end limit))) | |
357 (when (mh-in-header-p) | |
358 (set-match-data (list 1 lesser-limit)) | |
359 (goto-char lesser-limit) | |
360 t)))) | |
361 | |
362 (defun mh-header-field-font-lock (field limit) | |
363 "Return the value of a header field FIELD to font-lock. | |
364 Argument LIMIT limits search." | |
365 (if (= (point) limit) | |
366 nil | |
367 (let* ((mail-header-end (mh-mail-header-end)) | |
368 (lesser-limit (if (< mail-header-end limit) mail-header-end limit)) | |
369 (case-fold-search t)) | |
370 (when (and (< (point) mail-header-end) ;Only within header | |
371 (re-search-forward (format "^%s" field) lesser-limit t)) | |
372 (let ((match-one-b (match-beginning 0)) | |
373 (match-one-e (match-end 0))) | |
374 (mh-header-field-end) | |
375 (if (> (point) limit) ;Don't search for end beyond limit | |
376 (goto-char limit)) | |
377 (set-match-data (list match-one-b match-one-e | |
378 (1+ match-one-e) (point))) | |
379 t))))) | |
380 | |
381 (defun mh-header-to-font-lock (limit) | |
382 "Return the value of a header field To to font-lock. | |
383 Argument LIMIT limits search." | |
384 (mh-header-field-font-lock "To:" limit)) | |
385 | |
386 (defun mh-header-cc-font-lock (limit) | |
387 "Return the value of a header field cc to font-lock. | |
388 Argument LIMIT limits search." | |
389 (mh-header-field-font-lock "cc:" limit)) | |
390 | |
391 (defun mh-header-subject-font-lock (limit) | |
392 "Return the value of a header field Subject to font-lock. | |
393 Argument LIMIT limits search." | |
394 (mh-header-field-font-lock "Subject:" limit)) | |
395 | |
396 (eval-and-compile | |
397 ;; Otherwise byte-compilation fails on `mh-show-font-lock-keywords-with-cite' | |
398 (defvar mh-show-font-lock-keywords | |
399 '(("^\\(From:\\|Sender:\\)\\(.*\\)" | |
400 (1 'default) | |
401 (2 'mh-show-from)) | |
402 (mh-header-to-font-lock | |
403 (0 'default) | |
404 (1 'mh-show-to)) | |
405 (mh-header-cc-font-lock | |
406 (0 'default) | |
407 (1 'mh-show-cc)) | |
408 ("^\\(Reply-To:\\|Return-Path:\\)\\(.*\\)$" | |
409 (1 'default) | |
410 (2 'mh-show-from)) | |
411 (mh-header-subject-font-lock | |
412 (0 'default) | |
413 (1 'mh-show-subject)) | |
414 ("^\\(Apparently-To:\\|Newsgroups:\\)\\(.*\\)" | |
415 (1 'default) | |
416 (2 'mh-show-cc)) | |
417 ("^\\(In-reply-to\\|Date\\):\\(.*\\)$" | |
418 (1 'default) | |
419 (2 'mh-show-date)) | |
420 (mh-letter-header-font-lock | |
421 (0 'mh-show-header append t))) | |
422 "Additional expressions to highlight in MH-Show buffers.")) | |
423 | |
424 (defvar mh-show-font-lock-keywords-with-cite | |
425 (eval-when-compile | |
426 (let* ((cite-chars "[>|}]") | |
427 (cite-prefix "A-Za-z") | |
428 (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) | |
429 (append | |
430 mh-show-font-lock-keywords | |
431 (list | |
432 ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. | |
433 `(,cite-chars | |
434 (,(concat "\\=[ \t]*" | |
435 "\\(\\([" cite-prefix "]+[" cite-suffix "]*\\)?" | |
436 "\\(" cite-chars "[ \t]*\\)\\)+" | |
437 "\\(.*\\)") | |
438 (beginning-of-line) (end-of-line) | |
439 (2 font-lock-constant-face nil t) | |
440 (4 font-lock-comment-face nil t))))))) | |
441 "Additional expressions to highlight in MH-Show buffers.") | |
442 | |
443 (defvar mh-letter-font-lock-keywords | |
444 `(,@mh-show-font-lock-keywords-with-cite | |
445 (mh-font-lock-field-data | |
446 (1 'mh-letter-header-field prepend t))) | |
447 "Additional expressions to highlight in MH-Letter buffers.") | |
448 | |
449 (defun mh-show-font-lock-fontify-region (beg end loudly) | |
450 "Limit font-lock in `mh-show-mode' to the header. | |
451 | |
452 Used when the option `mh-highlight-citation-style' is set to | |
453 \"Gnus\", leaving the body to be dealt with by Gnus highlighting. | |
454 The region between BEG and END is given over to be fontified and | |
455 LOUDLY controls if a user sees a message about the fontification | |
456 operation." | |
457 (let ((header-end (mh-mail-header-end))) | |
458 (cond | |
459 ((and (< beg header-end)(< end header-end)) | |
460 (font-lock-default-fontify-region beg end loudly)) | |
461 ((and (< beg header-end)(>= end header-end)) | |
462 (font-lock-default-fontify-region beg header-end loudly)) | |
463 (t | |
464 nil)))) | |
465 | |
466 ;; Shush compiler. | |
467 (if mh-xemacs-flag | |
468 (eval-and-compile | |
469 (require 'gnus) | |
470 (require 'gnus-art) | |
471 (require 'gnus-cite))) | |
472 | |
473 (defun mh-gnus-article-highlight-citation () | |
474 "Highlight cited text in current buffer using Gnus." | |
475 (interactive) | |
476 ;; Requiring gnus-cite should have been sufficient. However for Emacs21.1, | |
477 ;; recursive-load-depth-limit is only 10, so an error occurs. Also it may be | |
478 ;; better to have an autoload at top-level (though that won't work because | |
479 ;; of recursive-load-depth-limit). That gets rid of a compiler warning as | |
480 ;; well. | |
481 (unless mh-xemacs-flag | |
482 (require 'gnus-art) | |
483 (require 'gnus-cite)) | |
484 ;; Don't allow Gnus to create buttons while highlighting, maybe this is bad | |
485 ;; style? | |
486 (flet ((gnus-article-add-button (&rest args) nil)) | |
487 (let* ((modified (buffer-modified-p)) | |
488 (gnus-article-buffer (buffer-name)) | |
489 (gnus-cite-face-list `(,@(cdr gnus-cite-face-list) | |
490 ,(car gnus-cite-face-list)))) | |
491 (gnus-article-highlight-citation t) | |
492 (set-buffer-modified-p modified)))) | |
493 | |
494 | |
495 | |
496 ;;; Internal bookkeeping variables: | |
497 | |
498 (defvar mh-user-path nil | |
499 "Cached value of the \"Path:\" MH profile component. | |
500 User's mail folder directory.") | |
501 | |
502 (defvar mh-draft-folder nil | |
503 "Cached value of the \"Draft-Folder:\" MH profile component. | |
504 Name of folder containing draft messages. | |
505 Nil means do not use a draft folder.") | |
506 | |
507 (defvar mh-unseen-seq nil | |
508 "Cached value of the \"Unseen-Sequence:\" MH profile component. | |
509 Name of the Unseen sequence.") | |
510 | |
511 (defvar mh-previous-seq nil | |
512 "Cached value of the \"Previous-Sequence:\" MH profile component. | |
513 Name of the Previous sequence.") | |
514 | |
515 (defvar mh-inbox nil | |
516 "Cached value of the \"Inbox:\" MH profile component. | |
517 Set to \"+inbox\" if no such component. | |
518 Name of the Inbox folder.") | |
519 | |
520 (defvar mh-previous-window-config nil | |
521 "Window configuration before MH-E command.") | |
522 | |
523 (defvar mh-page-to-next-msg-flag nil | |
524 "Non-nil means next SPC or whatever goes to next undeleted message.") | |
525 | |
526 | |
527 | |
528 ;;; Internal variables local to a folder. | |
529 | |
530 (defvar mh-current-folder nil | |
531 "Name of current folder, a string.") | |
532 | |
533 (defvar mh-show-buffer nil | |
534 "Buffer that displays message for this folder.") | |
535 | |
536 (defvar mh-folder-filename nil | |
537 "Full path of directory for this folder.") | |
538 | |
539 (defvar mh-msg-count nil | |
540 "Number of msgs in buffer.") | |
541 | |
542 (defvar mh-showing-mode nil | |
543 "If non-nil, show the message in a separate window.") | |
544 | |
545 (defvar mh-show-mode-map (make-sparse-keymap) | |
546 "Keymap used by the show buffer.") | |
547 | |
548 (defvar mh-show-folder-buffer nil | |
549 "Keeps track of folder whose message is being displayed.") | |
550 | 141 |
551 (defvar mh-logo-cache nil) | 142 (defvar mh-logo-cache nil) |
552 | 143 |
144 ;;;###mh-autoload | |
553 (defun mh-logo-display () | 145 (defun mh-logo-display () |
554 "Modify mode line to display MH-E logo." | 146 "Modify mode line to display MH-E logo." |
147 (mh-image-load-path) | |
555 (mh-do-in-gnu-emacs | 148 (mh-do-in-gnu-emacs |
556 (add-text-properties | 149 (add-text-properties |
557 0 2 | 150 0 2 |
558 `(display ,(or mh-logo-cache | 151 `(display ,(or mh-logo-cache |
559 (setq mh-logo-cache | 152 (setq mh-logo-cache |
567 (if mh-modeline-glyph | 160 (if mh-modeline-glyph |
568 (cons modeline-buffer-id-left-extent mh-modeline-glyph) | 161 (cons modeline-buffer-id-left-extent mh-modeline-glyph) |
569 (cons modeline-buffer-id-left-extent "XEmacs%N:")) | 162 (cons modeline-buffer-id-left-extent "XEmacs%N:")) |
570 (cons modeline-buffer-id-right-extent " %17b"))))) | 163 (cons modeline-buffer-id-right-extent " %17b"))))) |
571 | 164 |
572 (defun mh-showing-mode (&optional arg) | |
573 "Change whether messages should be displayed. | |
574 | |
575 With ARG, display messages iff ARG is positive." | |
576 (setq mh-showing-mode | |
577 (if (null arg) | |
578 (not mh-showing-mode) | |
579 (> (prefix-numeric-value arg) 0)))) | |
580 | |
581 (defvar mh-seq-list nil | |
582 "Alist of this folder's sequences. | |
583 Elements have the form (SEQUENCE . MESSAGES).") | |
584 | |
585 (defvar mh-seen-list nil | |
586 "List of displayed messages to be removed from the \"Unseen\" sequence.") | |
587 | |
588 (defvar mh-showing-with-headers nil | |
589 "If non-nil, MH-Show buffer contains message with all header fields. | |
590 If nil, MH-Show buffer contains message processed normally.") | |
591 | |
592 | 165 |
593 | 166 |
594 ;;; MH-E macros | 167 ;;; Read MH Profile |
595 | 168 |
596 (defmacro with-mh-folder-updating (save-modification-flag &rest body) | 169 (defvar mh-find-path-run nil |
597 "Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG) &body BODY). | 170 "Non-nil if `mh-find-path' has been run already. |
598 Execute BODY, which can modify the folder buffer without having to | 171 Do not access this variable; `mh-find-path' already uses it to |
599 worry about file locking or the read-only flag, and return its result. | 172 avoid running more than once.") |
600 If SAVE-MODIFICATION-FLAG is non-nil, the buffer's modification flag | 173 |
601 is unchanged, otherwise it is cleared." | 174 ;;;###mh-autoload |
602 (setq save-modification-flag (car save-modification-flag)) ; CL style | 175 (defun mh-find-path () |
603 `(prog1 | 176 "Set variables from user's MH profile. |
604 (let ((mh-folder-updating-mod-flag (buffer-modified-p)) | 177 |
605 (buffer-read-only nil) | 178 This function sets `mh-user-path' from your \"Path:\" MH profile |
606 (buffer-file-name nil)) ;don't let the buffer get locked | 179 component (but defaults to \"Mail\" if one isn't present), |
607 (prog1 | 180 `mh-draft-folder' from \"Draft-Folder:\", `mh-unseen-seq' from |
608 (progn | 181 \"Unseen-Sequence:\", `mh-previous-seq' from |
609 ,@body) | 182 \"Previous-Sequence:\", and `mh-inbox' from \"Inbox:\" (defaults |
610 (mh-set-folder-modified-p mh-folder-updating-mod-flag))) | 183 to \"+inbox\"). |
611 ,@(if (not save-modification-flag) | 184 |
612 '((mh-set-folder-modified-p nil))))) | 185 The hook `mh-find-path-hook' is run after these variables have |
613 | 186 been set. This hook can be used the change the value of these |
614 (put 'with-mh-folder-updating 'lisp-indent-hook 'defun) | 187 variables if you need to run with different values between MH and |
615 | 188 MH-E." |
616 (defmacro mh-in-show-buffer (show-buffer &rest body) | 189 (unless mh-find-path-run |
617 "Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY). | 190 ;; Sanity checks. |
618 Display buffer SHOW-BUFFER in other window and execute BODY in it. | 191 (if (and (getenv "MH") |
619 Stronger than `save-excursion', weaker than `save-window-excursion'." | 192 (not (file-readable-p (getenv "MH")))) |
620 (setq show-buffer (car show-buffer)) ; CL style | 193 (error "MH environment variable contains unreadable file %s" |
621 `(let ((mh-in-show-buffer-saved-window (selected-window))) | 194 (getenv "MH"))) |
622 (switch-to-buffer-other-window ,show-buffer) | 195 (if (null (mh-variants)) |
623 (if mh-bury-show-buffer-flag (bury-buffer (current-buffer))) | 196 (error "Install MH and run install-mh before running MH-E")) |
624 (unwind-protect | 197 (let ((profile "~/.mh_profile")) |
625 (progn | 198 (if (not (file-readable-p profile)) |
626 ,@body) | 199 (error "Run install-mh before running MH-E"))) |
627 (select-window mh-in-show-buffer-saved-window)))) | 200 ;; Read MH profile. |
628 | 201 (setq mh-user-path (mh-profile-component "Path")) |
629 (put 'mh-in-show-buffer 'lisp-indent-hook 'defun) | 202 (if (not mh-user-path) |
630 | 203 (setq mh-user-path "Mail")) |
631 (defmacro mh-do-at-event-location (event &rest body) | 204 (setq mh-user-path |
632 "Switch to the location of EVENT and execute BODY. | 205 (file-name-as-directory |
633 After BODY has been executed return to original window. The | 206 (expand-file-name mh-user-path (expand-file-name "~")))) |
634 modification flag of the buffer in the event window is | 207 (mh-set-x-image-cache-directory (expand-file-name ".mhe-x-image-cache" |
635 preserved." | 208 mh-user-path)) |
636 (let ((event-window (make-symbol "event-window")) | 209 (setq mh-draft-folder (mh-profile-component "Draft-Folder")) |
637 (event-position (make-symbol "event-position")) | 210 (if mh-draft-folder |
638 (original-window (make-symbol "original-window")) | 211 (progn |
639 (original-position (make-symbol "original-position")) | 212 (if (not (mh-folder-name-p mh-draft-folder)) |
640 (modified-flag (make-symbol "modified-flag"))) | 213 (setq mh-draft-folder (format "+%s" mh-draft-folder))) |
641 `(save-excursion | 214 (if (not (file-exists-p (mh-expand-file-name mh-draft-folder))) |
642 (let* ((,event-window | 215 (error |
643 (or (mh-funcall-if-exists posn-window (event-start ,event)) | 216 "Draft folder \"%s\" not found; create it and try again" |
644 (mh-funcall-if-exists event-window ,event))) | 217 (mh-expand-file-name mh-draft-folder))))) |
645 (,event-position | 218 (setq mh-inbox (mh-profile-component "Inbox")) |
646 (or (mh-funcall-if-exists posn-point (event-start ,event)) | 219 (cond ((not mh-inbox) |
647 (mh-funcall-if-exists event-closest-point ,event))) | 220 (setq mh-inbox "+inbox")) |
648 (,original-window (selected-window)) | 221 ((not (mh-folder-name-p mh-inbox)) |
649 (,original-position (progn | 222 (setq mh-inbox (format "+%s" mh-inbox)))) |
650 (set-buffer (window-buffer ,event-window)) | 223 (setq mh-unseen-seq (mh-profile-component "Unseen-Sequence")) |
651 (set-marker (make-marker) (point)))) | 224 (if mh-unseen-seq |
652 (,modified-flag (buffer-modified-p)) | 225 (setq mh-unseen-seq (intern mh-unseen-seq)) |
653 (buffer-read-only nil)) | 226 (setq mh-unseen-seq 'unseen)) ;old MH default? |
654 (unwind-protect (progn | 227 (setq mh-previous-seq (mh-profile-component "Previous-Sequence")) |
655 (select-window ,event-window) | 228 (if mh-previous-seq |
656 (goto-char ,event-position) | 229 (setq mh-previous-seq (intern mh-previous-seq))) |
657 ,@body) | 230 (run-hooks 'mh-find-path-hook) |
658 (set-buffer-modified-p ,modified-flag) | 231 (mh-collect-folder-names) |
659 (goto-char ,original-position) | 232 (setq mh-find-path-run t))) |
660 (set-marker ,original-position nil) | 233 |
661 (select-window ,original-window)))))) | 234 |
662 | 235 |
663 (put 'mh-do-at-event-location 'lisp-indent-hook 'defun) | 236 ;;; Help Functions |
664 | 237 |
665 (defmacro mh-make-seq (name msgs) | 238 ;;;###mh-autoload |
666 "Create sequence NAME with the given MSGS." | 239 (defun mh-ephem-message (string) |
667 (list 'cons name msgs)) | 240 "Display STRING in the minibuffer momentarily." |
668 | 241 (message "%s" string) |
669 (defmacro mh-seq-name (sequence) | 242 (sit-for 5) |
670 "Extract sequence name from the given SEQUENCE." | 243 (message "")) |
671 (list 'car sequence)) | 244 |
672 | 245 (defvar mh-help-default nil |
673 (defmacro mh-seq-msgs (sequence) | 246 "Mode to use if messages are not present for the current mode.") |
674 "Extract messages from the given SEQUENCE." | 247 |
675 (list 'cdr sequence)) | 248 (defvar mh-help-messages nil |
676 | 249 "Help messages for all modes. |
677 (defun mh-recenter (arg) | 250 This is an alist of alists. The primary key is a symbol |
678 "Like recenter but with three improvements: | 251 representing the mode; the value is described in `mh-set-help'.") |
679 | 252 |
680 - At the end of the buffer it tries to show fewer empty lines. | 253 ;;;###mh-autoload |
681 | 254 (defun mh-set-help (messages &optional default) |
682 - operates only if the current buffer is in the selected window. | 255 "Set help messages. |
683 (Commands like `save-some-buffers' can make this false.) | 256 |
684 | 257 The MESSAGES are assumed to be an associative array. It is used |
685 - nil ARG means recenter as if prefix argument had been given." | 258 to show help for the most common commands in the current mode. |
686 (cond ((not (eq (get-buffer-window (current-buffer)) (selected-window))) | 259 The key is a prefix char. The value is one or more strings which |
687 nil) | 260 are concatenated together and displayed in a help buffer if ? is |
688 ((= (point-max) (save-excursion | 261 pressed after the prefix character. The special key nil is used |
689 (forward-line (- (/ (window-height) 2) 2)) | 262 to display the non-prefixed commands. |
690 (point))) | 263 |
691 (let ((lines-from-end 2)) | 264 The substitutions described in `substitute-command-keys' are performed as |
692 (save-excursion | 265 well. |
693 (while (> (point-max) (progn (forward-line) (point))) | 266 |
694 (incf lines-from-end))) | 267 If optional argument DEFAULT is non-nil, then these messages will |
695 (recenter (- lines-from-end)))) | 268 be used if help is asked for an unknown mode." |
696 ;; '(4) is the same as C-u prefix argument. | 269 (add-to-list 'mh-help-messages (cons major-mode messages)) |
697 (t (recenter (or arg '(4)))))) | 270 (if default |
698 | 271 (setq mh-help-default major-mode))) |
699 (defun mh-start-of-uncleaned-message () | 272 |
700 "Position uninteresting headers off the top of the window." | 273 ;;;###mh-autoload |
701 (let ((case-fold-search t)) | 274 (defun mh-help (&optional help-messages) |
702 (re-search-forward | 275 "Display cheat sheet for the MH-E commands. |
703 "^To:\\|^Cc:\\|^From:\\|^Subject:\\|^Date:" nil t) | 276 See `mh-set-help' for setting the help messages. |
704 (beginning-of-line) | 277 HELP-MESSAGES are used instead if given. |
705 (mh-recenter 0))) | 278 This is a list of one or more strings which are concatenated together |
706 | 279 and displayed in a help buffer." |
707 (defun mh-invalidate-show-buffer () | 280 (interactive) |
708 "Invalidate the show buffer so we must update it to use it." | 281 (let* ((help (or help-messages |
709 (if (get-buffer mh-show-buffer) | 282 (cdr (assoc nil (assoc major-mode mh-help-messages))))) |
710 (save-excursion | 283 (text (substitute-command-keys (mapconcat 'identity help "")))) |
711 (set-buffer mh-show-buffer) | 284 (with-electric-help |
712 (mh-unvisit-file)))) | 285 (function |
713 | 286 (lambda () |
714 (defun mh-unvisit-file () | 287 (insert text))) |
715 "Separate current buffer from the message file it was visiting." | 288 mh-help-buffer))) |
716 (or (not (buffer-modified-p)) | 289 |
717 (null buffer-file-name) ;we've been here before | 290 ;;;###mh-autoload |
718 (yes-or-no-p (format "Message %s modified; flush changes? " | 291 (defun mh-prefix-help () |
719 (file-name-nondirectory buffer-file-name))) | 292 "Display cheat sheet for the commands of the current prefix in minibuffer." |
720 (error "Flushing changes not confirmed")) | 293 (interactive) |
721 (clear-visited-file-modtime) | 294 ;; We got here because the user pressed a "?", but he pressed a prefix key |
722 (unlock-buffer) | 295 ;; before that. Since the the key vector starts at index 0, the index of the |
723 (setq buffer-file-name nil)) | 296 ;; last keystroke is length-1 and thus the second to last keystroke is at |
724 | 297 ;; length-2. We use that information to obtain a suitable prefix character |
298 ;; from the recent keys. | |
299 (let* ((keys (recent-keys)) | |
300 (prefix-char (elt keys (- (length keys) 2))) | |
301 (help (cdr (assoc prefix-char (assoc major-mode mh-help-messages))))) | |
302 (mh-help help))) | |
303 | |
304 | |
305 | |
306 ;;; Message Number Utilities | |
307 | |
308 ;;;###mh-autoload | |
309 (defun mh-coalesce-msg-list (messages) | |
310 "Given a list of MESSAGES, return a list of message number ranges. | |
311 This is the inverse of `mh-read-msg-list', which expands ranges. | |
312 Message lists passed to MH programs should be processed by this | |
313 function to avoid exceeding system command line argument limits." | |
314 (let ((msgs (sort (copy-sequence messages) 'mh-greaterp)) | |
315 (range-high nil) | |
316 (prev -1) | |
317 (ranges nil)) | |
318 (while prev | |
319 (if range-high | |
320 (if (or (not (numberp prev)) | |
321 (not (equal (car msgs) (1- prev)))) | |
322 (progn ;non-sequential, flush old range | |
323 (if (eq prev range-high) | |
324 (setq ranges (cons range-high ranges)) | |
325 (setq ranges (cons (format "%s-%s" prev range-high) ranges))) | |
326 (setq range-high nil)))) | |
327 (or range-high | |
328 (setq range-high (car msgs))) ;start new or first range | |
329 (setq prev (car msgs)) | |
330 (setq msgs (cdr msgs))) | |
331 ranges)) | |
332 | |
333 (defun mh-greaterp (msg1 msg2) | |
334 "Return the greater of two message indicators MSG1 and MSG2. | |
335 Strings are \"smaller\" than numbers. | |
336 Valid values are things like \"cur\", \"last\", 1, and 1820." | |
337 (if (numberp msg1) | |
338 (if (numberp msg2) | |
339 (> msg1 msg2) | |
340 t) | |
341 (if (numberp msg2) | |
342 nil | |
343 (string-lessp msg2 msg1)))) | |
344 | |
345 ;;;###mh-autoload | |
346 (defun mh-lessp (msg1 msg2) | |
347 "Return the lesser of two message indicators MSG1 and MSG2. | |
348 Strings are \"smaller\" than numbers. | |
349 Valid values are things like \"cur\", \"last\", 1, and 1820." | |
350 (not (mh-greaterp msg1 msg2))) | |
351 | |
352 ;;;###mh-autoload | |
725 (defun mh-get-msg-num (error-if-no-message) | 353 (defun mh-get-msg-num (error-if-no-message) |
726 "Return the message number of the displayed message. | 354 "Return the message number of the displayed message. |
727 If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if | 355 If the argument ERROR-IF-NO-MESSAGE is non-nil, then complain if |
728 the cursor is not pointing to a message." | 356 the cursor is not pointing to a message." |
729 (save-excursion | 357 (save-excursion |
730 (beginning-of-line) | 358 (beginning-of-line) |
731 (cond ((looking-at mh-scan-msg-number-regexp) | 359 (cond ((looking-at (mh-scan-msg-number-regexp)) |
732 (string-to-number (buffer-substring (match-beginning 1) | 360 (string-to-number (buffer-substring (match-beginning 1) |
733 (match-end 1)))) | 361 (match-end 1)))) |
734 (error-if-no-message | 362 (error-if-no-message |
735 (error "Cursor not pointing to message")) | 363 (error "Cursor not pointing to message")) |
736 (t nil)))) | 364 (t nil)))) |
737 | 365 |
738 (defun mh-folder-name-p (name) | 366 (add-to-list 'debug-ignored-errors "^Cursor not pointing to message$") |
739 "Return non-nil if NAME is the name of a folder. | |
740 A name (a string or symbol) can be a folder name if it begins | |
741 with \"+\"." | |
742 (if (symbolp name) | |
743 (eq (aref (symbol-name name) 0) ?+) | |
744 (and (> (length name) 0) | |
745 (eq (aref name 0) ?+)))) | |
746 | |
747 (defun mh-expand-file-name (filename &optional default) | |
748 "Expand FILENAME like `expand-file-name', but also handle MH folder names. | |
749 Any filename that starts with '+' is treated as a folder name. | |
750 See `expand-file-name' for description of DEFAULT." | |
751 (if (mh-folder-name-p filename) | |
752 (expand-file-name (substring filename 1) mh-user-path) | |
753 (expand-file-name filename default))) | |
754 | |
755 (defun mh-msg-filename (msg &optional folder) | |
756 "Return the file name of MSG in FOLDER (default current folder)." | |
757 (expand-file-name (int-to-string msg) | |
758 (if folder | |
759 (mh-expand-file-name folder) | |
760 mh-folder-filename))) | |
761 | |
762 ;; Infrastructure to generate show-buffer functions from folder functions | |
763 ;; XEmacs does not have deactivate-mark? What is the equivalent of | |
764 ;; transient-mark-mode for XEmacs? Should we be restoring the mark in the | |
765 ;; folder buffer after the operation has been carried out. | |
766 (defmacro mh-defun-show-buffer (function original-function | |
767 &optional dont-return) | |
768 "Define FUNCTION to run ORIGINAL-FUNCTION in folder buffer. | |
769 If the buffer we start in is still visible and DONT-RETURN is nil | |
770 then switch to it after that." | |
771 `(defun ,function () | |
772 ,(format "Calls %s from the message's folder.\n%s\nSee \"%s\" for more info.\n" | |
773 original-function | |
774 (if dont-return "" | |
775 "When function completes, returns to the show buffer if it is | |
776 still visible.\n") | |
777 original-function) | |
778 (interactive) | |
779 (when (buffer-live-p (get-buffer mh-show-folder-buffer)) | |
780 (let ((config (current-window-configuration)) | |
781 (folder-buffer mh-show-folder-buffer) | |
782 (normal-exit nil) | |
783 ,@(if dont-return () '((cur-buffer-name (buffer-name))))) | |
784 (pop-to-buffer mh-show-folder-buffer nil) | |
785 (unless (equal (buffer-name | |
786 (window-buffer (frame-first-window (selected-frame)))) | |
787 folder-buffer) | |
788 (delete-other-windows)) | |
789 (mh-goto-cur-msg t) | |
790 (mh-funcall-if-exists deactivate-mark) | |
791 (unwind-protect | |
792 (prog1 (call-interactively (function ,original-function)) | |
793 (setq normal-exit t)) | |
794 (mh-funcall-if-exists deactivate-mark) | |
795 (when (eq major-mode 'mh-folder-mode) | |
796 (mh-funcall-if-exists hl-line-highlight)) | |
797 (cond ((not normal-exit) | |
798 (set-window-configuration config)) | |
799 ,(if dont-return | |
800 `(t (setq mh-previous-window-config config)) | |
801 `((and (get-buffer cur-buffer-name) | |
802 (window-live-p (get-buffer-window | |
803 (get-buffer cur-buffer-name)))) | |
804 (pop-to-buffer (get-buffer cur-buffer-name) nil))))))))) | |
805 | |
806 ;; Generate interactive functions for the show buffer from the corresponding | |
807 ;; folder functions. | |
808 (mh-defun-show-buffer mh-show-previous-undeleted-msg | |
809 mh-previous-undeleted-msg) | |
810 (mh-defun-show-buffer mh-show-next-undeleted-msg | |
811 mh-next-undeleted-msg) | |
812 (mh-defun-show-buffer mh-show-quit mh-quit) | |
813 (mh-defun-show-buffer mh-show-delete-msg mh-delete-msg) | |
814 (mh-defun-show-buffer mh-show-refile-msg mh-refile-msg) | |
815 (mh-defun-show-buffer mh-show-undo mh-undo) | |
816 (mh-defun-show-buffer mh-show-execute-commands mh-execute-commands) | |
817 (mh-defun-show-buffer mh-show-reply mh-reply t) | |
818 (mh-defun-show-buffer mh-show-redistribute mh-redistribute) | |
819 (mh-defun-show-buffer mh-show-forward mh-forward t) | |
820 (mh-defun-show-buffer mh-show-header-display mh-header-display) | |
821 (mh-defun-show-buffer mh-show-refile-or-write-again | |
822 mh-refile-or-write-again) | |
823 (mh-defun-show-buffer mh-show-show mh-show) | |
824 (mh-defun-show-buffer mh-show-write-message-to-file | |
825 mh-write-msg-to-file) | |
826 (mh-defun-show-buffer mh-show-extract-rejected-mail | |
827 mh-extract-rejected-mail t) | |
828 (mh-defun-show-buffer mh-show-delete-msg-no-motion | |
829 mh-delete-msg-no-motion) | |
830 (mh-defun-show-buffer mh-show-first-msg mh-first-msg) | |
831 (mh-defun-show-buffer mh-show-last-msg mh-last-msg) | |
832 (mh-defun-show-buffer mh-show-copy-msg mh-copy-msg) | |
833 (mh-defun-show-buffer mh-show-edit-again mh-edit-again t) | |
834 (mh-defun-show-buffer mh-show-goto-msg mh-goto-msg) | |
835 (mh-defun-show-buffer mh-show-inc-folder mh-inc-folder) | |
836 (mh-defun-show-buffer mh-show-delete-subject-or-thread | |
837 mh-delete-subject-or-thread) | |
838 (mh-defun-show-buffer mh-show-delete-subject mh-delete-subject) | |
839 (mh-defun-show-buffer mh-show-print-msg mh-print-msg) | |
840 (mh-defun-show-buffer mh-show-send mh-send t) | |
841 (mh-defun-show-buffer mh-show-toggle-showing mh-toggle-showing t) | |
842 (mh-defun-show-buffer mh-show-pipe-msg mh-pipe-msg t) | |
843 (mh-defun-show-buffer mh-show-sort-folder mh-sort-folder) | |
844 (mh-defun-show-buffer mh-show-visit-folder mh-visit-folder t) | |
845 (mh-defun-show-buffer mh-show-rescan-folder mh-rescan-folder) | |
846 (mh-defun-show-buffer mh-show-pack-folder mh-pack-folder) | |
847 (mh-defun-show-buffer mh-show-kill-folder mh-kill-folder t) | |
848 (mh-defun-show-buffer mh-show-list-folders mh-list-folders t) | |
849 (mh-defun-show-buffer mh-show-undo-folder mh-undo-folder) | |
850 (mh-defun-show-buffer mh-show-delete-msg-from-seq | |
851 mh-delete-msg-from-seq) | |
852 (mh-defun-show-buffer mh-show-delete-seq mh-delete-seq) | |
853 (mh-defun-show-buffer mh-show-list-sequences mh-list-sequences) | |
854 (mh-defun-show-buffer mh-show-narrow-to-seq mh-narrow-to-seq) | |
855 (mh-defun-show-buffer mh-show-put-msg-in-seq mh-put-msg-in-seq) | |
856 (mh-defun-show-buffer mh-show-msg-is-in-seq mh-msg-is-in-seq) | |
857 (mh-defun-show-buffer mh-show-widen mh-widen) | |
858 (mh-defun-show-buffer mh-show-narrow-to-subject mh-narrow-to-subject) | |
859 (mh-defun-show-buffer mh-show-narrow-to-from mh-narrow-to-from) | |
860 (mh-defun-show-buffer mh-show-narrow-to-cc mh-narrow-to-cc) | |
861 (mh-defun-show-buffer mh-show-narrow-to-range mh-narrow-to-range) | |
862 (mh-defun-show-buffer mh-show-narrow-to-to mh-narrow-to-to) | |
863 (mh-defun-show-buffer mh-show-store-msg mh-store-msg) | |
864 (mh-defun-show-buffer mh-show-page-digest mh-page-digest) | |
865 (mh-defun-show-buffer mh-show-page-digest-backwards | |
866 mh-page-digest-backwards) | |
867 (mh-defun-show-buffer mh-show-burst-digest mh-burst-digest) | |
868 (mh-defun-show-buffer mh-show-page-msg mh-page-msg) | |
869 (mh-defun-show-buffer mh-show-previous-page mh-previous-page) | |
870 (mh-defun-show-buffer mh-show-modify mh-modify t) | |
871 (mh-defun-show-buffer mh-show-next-button mh-next-button) | |
872 (mh-defun-show-buffer mh-show-prev-button mh-prev-button) | |
873 (mh-defun-show-buffer mh-show-toggle-mime-part mh-folder-toggle-mime-part) | |
874 (mh-defun-show-buffer mh-show-save-mime-part mh-folder-save-mime-part) | |
875 (mh-defun-show-buffer mh-show-inline-mime-part mh-folder-inline-mime-part) | |
876 (mh-defun-show-buffer mh-show-toggle-threads mh-toggle-threads) | |
877 (mh-defun-show-buffer mh-show-thread-delete mh-thread-delete) | |
878 (mh-defun-show-buffer mh-show-thread-refile mh-thread-refile) | |
879 (mh-defun-show-buffer mh-show-update-sequences mh-update-sequences) | |
880 (mh-defun-show-buffer mh-show-next-unread-msg mh-next-unread-msg) | |
881 (mh-defun-show-buffer mh-show-previous-unread-msg mh-previous-unread-msg) | |
882 (mh-defun-show-buffer mh-show-thread-ancestor mh-thread-ancestor) | |
883 (mh-defun-show-buffer mh-show-thread-next-sibling mh-thread-next-sibling) | |
884 (mh-defun-show-buffer mh-show-thread-previous-sibling | |
885 mh-thread-previous-sibling) | |
886 (mh-defun-show-buffer mh-show-index-visit-folder mh-index-visit-folder t) | |
887 (mh-defun-show-buffer mh-show-toggle-tick mh-toggle-tick) | |
888 (mh-defun-show-buffer mh-show-narrow-to-tick mh-narrow-to-tick) | |
889 (mh-defun-show-buffer mh-show-junk-blacklist mh-junk-blacklist) | |
890 (mh-defun-show-buffer mh-show-junk-whitelist mh-junk-whitelist) | |
891 (mh-defun-show-buffer mh-show-index-new-messages mh-index-new-messages) | |
892 (mh-defun-show-buffer mh-show-index-ticked-messages mh-index-ticked-messages) | |
893 (mh-defun-show-buffer mh-show-index-sequenced-messages | |
894 mh-index-sequenced-messages) | |
895 (mh-defun-show-buffer mh-show-catchup mh-catchup) | |
896 (mh-defun-show-buffer mh-show-ps-print-toggle-color mh-ps-print-toggle-color) | |
897 (mh-defun-show-buffer mh-show-ps-print-toggle-faces mh-ps-print-toggle-faces) | |
898 (mh-defun-show-buffer mh-show-ps-print-msg-file mh-ps-print-msg-file) | |
899 (mh-defun-show-buffer mh-show-ps-print-msg mh-ps-print-msg) | |
900 (mh-defun-show-buffer mh-show-toggle-mime-buttons mh-toggle-mime-buttons) | |
901 (mh-defun-show-buffer mh-show-display-with-external-viewer | |
902 mh-display-with-external-viewer) | |
903 | 367 |
904 | 368 |
905 | 369 |
906 ;;; Build mh-show-mode keymaps | 370 ;;; Folder Cache and Access |
907 | |
908 (gnus-define-keys mh-show-mode-map | |
909 " " mh-show-page-msg | |
910 "!" mh-show-refile-or-write-again | |
911 "'" mh-show-toggle-tick | |
912 "," mh-show-header-display | |
913 "." mh-show-show | |
914 ">" mh-show-write-message-to-file | |
915 "?" mh-help | |
916 "E" mh-show-extract-rejected-mail | |
917 "M" mh-show-modify | |
918 "\177" mh-show-previous-page | |
919 "\C-d" mh-show-delete-msg-no-motion | |
920 "\t" mh-show-next-button | |
921 [backtab] mh-show-prev-button | |
922 "\M-\t" mh-show-prev-button | |
923 "\ed" mh-show-redistribute | |
924 "^" mh-show-refile-msg | |
925 "c" mh-show-copy-msg | |
926 "d" mh-show-delete-msg | |
927 "e" mh-show-edit-again | |
928 "f" mh-show-forward | |
929 "g" mh-show-goto-msg | |
930 "i" mh-show-inc-folder | |
931 "k" mh-show-delete-subject-or-thread | |
932 "m" mh-show-send | |
933 "n" mh-show-next-undeleted-msg | |
934 "\M-n" mh-show-next-unread-msg | |
935 "o" mh-show-refile-msg | |
936 "p" mh-show-previous-undeleted-msg | |
937 "\M-p" mh-show-previous-unread-msg | |
938 "q" mh-show-quit | |
939 "r" mh-show-reply | |
940 "s" mh-show-send | |
941 "t" mh-show-toggle-showing | |
942 "u" mh-show-undo | |
943 "x" mh-show-execute-commands | |
944 "v" mh-show-index-visit-folder | |
945 "|" mh-show-pipe-msg) | |
946 | |
947 (gnus-define-keys (mh-show-folder-map "F" mh-show-mode-map) | |
948 "?" mh-prefix-help | |
949 "'" mh-index-ticked-messages | |
950 "S" mh-show-sort-folder | |
951 "c" mh-show-catchup | |
952 "f" mh-show-visit-folder | |
953 "k" mh-show-kill-folder | |
954 "l" mh-show-list-folders | |
955 "n" mh-index-new-messages | |
956 "o" mh-show-visit-folder | |
957 "q" mh-show-index-sequenced-messages | |
958 "r" mh-show-rescan-folder | |
959 "s" mh-search | |
960 "t" mh-show-toggle-threads | |
961 "u" mh-show-undo-folder | |
962 "v" mh-show-visit-folder) | |
963 | |
964 (gnus-define-keys (mh-show-sequence-map "S" mh-show-mode-map) | |
965 "'" mh-show-narrow-to-tick | |
966 "?" mh-prefix-help | |
967 "d" mh-show-delete-msg-from-seq | |
968 "k" mh-show-delete-seq | |
969 "l" mh-show-list-sequences | |
970 "n" mh-show-narrow-to-seq | |
971 "p" mh-show-put-msg-in-seq | |
972 "s" mh-show-msg-is-in-seq | |
973 "w" mh-show-widen) | |
974 | |
975 (define-key mh-show-mode-map "I" mh-inc-spool-map) | |
976 | |
977 (gnus-define-keys (mh-show-junk-map "J" mh-show-mode-map) | |
978 "?" mh-prefix-help | |
979 "b" mh-show-junk-blacklist | |
980 "w" mh-show-junk-whitelist) | |
981 | |
982 (gnus-define-keys (mh-show-ps-print-map "P" mh-show-mode-map) | |
983 "?" mh-prefix-help | |
984 "C" mh-show-ps-print-toggle-color | |
985 "F" mh-show-ps-print-toggle-faces | |
986 "f" mh-show-ps-print-msg-file | |
987 "l" mh-show-print-msg | |
988 "p" mh-show-ps-print-msg) | |
989 | |
990 (gnus-define-keys (mh-show-thread-map "T" mh-show-mode-map) | |
991 "?" mh-prefix-help | |
992 "u" mh-show-thread-ancestor | |
993 "p" mh-show-thread-previous-sibling | |
994 "n" mh-show-thread-next-sibling | |
995 "t" mh-show-toggle-threads | |
996 "d" mh-show-thread-delete | |
997 "o" mh-show-thread-refile) | |
998 | |
999 (gnus-define-keys (mh-show-limit-map "/" mh-show-mode-map) | |
1000 "'" mh-show-narrow-to-tick | |
1001 "?" mh-prefix-help | |
1002 "c" mh-show-narrow-to-cc | |
1003 "g" mh-show-narrow-to-range | |
1004 "m" mh-show-narrow-to-from | |
1005 "s" mh-show-narrow-to-subject | |
1006 "t" mh-show-narrow-to-to | |
1007 "w" mh-show-widen) | |
1008 | |
1009 (gnus-define-keys (mh-show-extract-map "X" mh-show-mode-map) | |
1010 "?" mh-prefix-help | |
1011 "s" mh-show-store-msg | |
1012 "u" mh-show-store-msg) | |
1013 | |
1014 ;; Untested... | |
1015 (gnus-define-keys (mh-show-digest-map "D" mh-show-mode-map) | |
1016 "?" mh-prefix-help | |
1017 " " mh-show-page-digest | |
1018 "\177" mh-show-page-digest-backwards | |
1019 "b" mh-show-burst-digest) | |
1020 | |
1021 (gnus-define-keys (mh-show-mime-map "K" mh-show-mode-map) | |
1022 "?" mh-prefix-help | |
1023 "a" mh-mime-save-parts | |
1024 "e" mh-show-display-with-external-viewer | |
1025 "v" mh-show-toggle-mime-part | |
1026 "o" mh-show-save-mime-part | |
1027 "i" mh-show-inline-mime-part | |
1028 "t" mh-show-toggle-mime-buttons | |
1029 "\t" mh-show-next-button | |
1030 [backtab] mh-show-prev-button | |
1031 "\M-\t" mh-show-prev-button) | |
1032 | |
1033 (easy-menu-define | |
1034 mh-show-sequence-menu mh-show-mode-map "Menu for MH-E folder-sequence." | |
1035 '("Sequence" | |
1036 ["Add Message to Sequence..." mh-show-put-msg-in-seq t] | |
1037 ["List Sequences for Message" mh-show-msg-is-in-seq t] | |
1038 ["Delete Message from Sequence..." mh-show-delete-msg-from-seq t] | |
1039 ["List Sequences in Folder..." mh-show-list-sequences t] | |
1040 ["Delete Sequence..." mh-show-delete-seq t] | |
1041 ["Narrow to Sequence..." mh-show-narrow-to-seq t] | |
1042 ["Widen from Sequence" mh-show-widen t] | |
1043 "--" | |
1044 ["Narrow to Subject Sequence" mh-show-narrow-to-subject t] | |
1045 ["Narrow to Tick Sequence" mh-show-narrow-to-tick | |
1046 (save-excursion | |
1047 (set-buffer mh-show-folder-buffer) | |
1048 (and mh-tick-seq (mh-seq-msgs (mh-find-seq mh-tick-seq))))] | |
1049 ["Delete Rest of Same Subject" mh-show-delete-subject t] | |
1050 ["Toggle Tick Mark" mh-show-toggle-tick t] | |
1051 "--" | |
1052 ["Push State Out to MH" mh-show-update-sequences t])) | |
1053 | |
1054 (easy-menu-define | |
1055 mh-show-message-menu mh-show-mode-map "Menu for MH-E folder-message." | |
1056 '("Message" | |
1057 ["Show Message" mh-show-show t] | |
1058 ["Show Message with Header" mh-show-header-display t] | |
1059 ["Next Message" mh-show-next-undeleted-msg t] | |
1060 ["Previous Message" mh-show-previous-undeleted-msg t] | |
1061 ["Go to First Message" mh-show-first-msg t] | |
1062 ["Go to Last Message" mh-show-last-msg t] | |
1063 ["Go to Message by Number..." mh-show-goto-msg t] | |
1064 ["Modify Message" mh-show-modify t] | |
1065 ["Delete Message" mh-show-delete-msg t] | |
1066 ["Refile Message" mh-show-refile-msg t] | |
1067 ["Undo Delete/Refile" mh-show-undo t] | |
1068 ["Process Delete/Refile" mh-show-execute-commands t] | |
1069 "--" | |
1070 ["Compose a New Message" mh-send t] | |
1071 ["Reply to Message..." mh-show-reply t] | |
1072 ["Forward Message..." mh-show-forward t] | |
1073 ["Redistribute Message..." mh-show-redistribute t] | |
1074 ["Edit Message Again" mh-show-edit-again t] | |
1075 ["Re-edit a Bounced Message" mh-show-extract-rejected-mail t] | |
1076 "--" | |
1077 ["Copy Message to Folder..." mh-show-copy-msg t] | |
1078 ["Print Message" mh-show-print-msg t] | |
1079 ["Write Message to File..." mh-show-write-msg-to-file t] | |
1080 ["Pipe Message to Command..." mh-show-pipe-msg t] | |
1081 ["Unpack Uuencoded Message..." mh-show-store-msg t] | |
1082 ["Burst Digest Message" mh-show-burst-digest t])) | |
1083 | |
1084 (easy-menu-define | |
1085 mh-show-folder-menu mh-show-mode-map "Menu for MH-E folder." | |
1086 '("Folder" | |
1087 ["Incorporate New Mail" mh-show-inc-folder t] | |
1088 ["Toggle Show/Folder" mh-show-toggle-showing t] | |
1089 ["Execute Delete/Refile" mh-show-execute-commands t] | |
1090 ["Rescan Folder" mh-show-rescan-folder t] | |
1091 ["Thread Folder" mh-show-toggle-threads t] | |
1092 ["Pack Folder" mh-show-pack-folder t] | |
1093 ["Sort Folder" mh-show-sort-folder t] | |
1094 "--" | |
1095 ["List Folders" mh-show-list-folders t] | |
1096 ["Visit a Folder..." mh-show-visit-folder t] | |
1097 ["View New Messages" mh-show-index-new-messages t] | |
1098 ["Search..." mh-search t] | |
1099 "--" | |
1100 ["Quit MH-E" mh-quit t])) | |
1101 | |
1102 ;; Ensure new buffers won't get this mode if default-major-mode is nil. | |
1103 (put 'mh-show-mode 'mode-class 'special) | |
1104 | |
1105 ;; Shush compiler. | |
1106 (eval-when-compile (defvar font-lock-auto-fontify)) | |
1107 | |
1108 (define-derived-mode mh-show-mode text-mode "MH-Show" | |
1109 "Major mode for showing messages in MH-E.\\<mh-show-mode-map> | |
1110 | |
1111 The hook `mh-show-mode-hook' is called upon entry to this mode. | |
1112 | |
1113 See also `mh-folder-mode'. | |
1114 | |
1115 \\{mh-show-mode-map}" | |
1116 (set (make-local-variable 'mail-header-separator) mh-mail-header-separator) | |
1117 (setq paragraph-start (default-value 'paragraph-start)) | |
1118 (mh-show-unquote-From) | |
1119 (mh-show-xface) | |
1120 (mh-show-addr) | |
1121 (setq buffer-invisibility-spec '((vanish . t) t)) | |
1122 (set (make-local-variable 'line-move-ignore-invisible) t) | |
1123 (make-local-variable 'font-lock-defaults) | |
1124 ;;(set (make-local-variable 'font-lock-support-mode) nil) | |
1125 (cond | |
1126 ((equal mh-highlight-citation-style 'font-lock) | |
1127 (setq font-lock-defaults '(mh-show-font-lock-keywords-with-cite t))) | |
1128 ((equal mh-highlight-citation-style 'gnus) | |
1129 (setq font-lock-defaults '((mh-show-font-lock-keywords) | |
1130 t nil nil nil | |
1131 (font-lock-fontify-region-function | |
1132 . mh-show-font-lock-fontify-region))) | |
1133 (mh-gnus-article-highlight-citation)) | |
1134 (t | |
1135 (setq font-lock-defaults '(mh-show-font-lock-keywords t)))) | |
1136 (if (and mh-xemacs-flag | |
1137 font-lock-auto-fontify) | |
1138 (turn-on-font-lock)) | |
1139 (set (make-local-variable 'tool-bar-map) mh-show-tool-bar-map) | |
1140 (mh-funcall-if-exists mh-tool-bar-init :show) | |
1141 (when mh-decode-mime-flag | |
1142 (mh-make-local-hook 'kill-buffer-hook) | |
1143 (add-hook 'kill-buffer-hook 'mh-mime-cleanup nil t)) | |
1144 (easy-menu-add mh-show-sequence-menu) | |
1145 (easy-menu-add mh-show-message-menu) | |
1146 (easy-menu-add mh-show-folder-menu) | |
1147 (make-local-variable 'mh-show-folder-buffer) | |
1148 (buffer-disable-undo) | |
1149 (setq buffer-read-only t) | |
1150 (use-local-map mh-show-mode-map)) | |
1151 | |
1152 (defun mh-show-addr () | |
1153 "Use `goto-address'." | |
1154 (when mh-show-use-goto-addr-flag | |
1155 (if (not (featurep 'goto-addr)) | |
1156 (load "goto-addr" t t)) | |
1157 (if (fboundp 'goto-address) | |
1158 (goto-address)))) | |
1159 | |
1160 | |
1161 | |
1162 ;; X-Face and Face display | |
1163 (defvar mh-show-xface-function | |
1164 (cond ((and mh-xemacs-flag (locate-library "x-face") (not (featurep 'xface))) | |
1165 (load "x-face" t t) | |
1166 #'mh-face-display-function) | |
1167 ((>= emacs-major-version 21) | |
1168 #'mh-face-display-function) | |
1169 (t #'ignore)) | |
1170 "Determine at run time what function should be called to display X-Face.") | |
1171 | |
1172 (defvar mh-uncompface-executable | |
1173 (and (fboundp 'executable-find) (executable-find "uncompface"))) | |
1174 | |
1175 (defun mh-face-to-png (data) | |
1176 "Convert base64 encoded DATA to png image." | |
1177 (with-temp-buffer | |
1178 (insert data) | |
1179 (ignore-errors (base64-decode-region (point-min) (point-max))) | |
1180 (buffer-string))) | |
1181 | |
1182 (defun mh-uncompface (data) | |
1183 "Run DATA through `uncompface' to generate bitmap." | |
1184 (with-temp-buffer | |
1185 (insert data) | |
1186 (when (and mh-uncompface-executable | |
1187 (equal (call-process-region (point-min) (point-max) | |
1188 mh-uncompface-executable t '(t nil)) | |
1189 0)) | |
1190 (mh-icontopbm) | |
1191 (buffer-string)))) | |
1192 | |
1193 (defun mh-icontopbm () | |
1194 "Elisp substitute for `icontopbm'." | |
1195 (goto-char (point-min)) | |
1196 (let ((end (point-max))) | |
1197 (while (re-search-forward "0x\\(..\\)\\(..\\)," nil t) | |
1198 (save-excursion | |
1199 (goto-char (point-max)) | |
1200 (insert (string-to-number (match-string 1) 16)) | |
1201 (insert (string-to-number (match-string 2) 16)))) | |
1202 (delete-region (point-min) end) | |
1203 (goto-char (point-min)) | |
1204 (insert "P4\n48 48\n"))) | |
1205 | |
1206 (mh-do-in-xemacs (defvar default-enable-multibyte-characters)) | |
1207 | |
1208 (defmacro mh-face-foreground-compat (face &optional frame inherit) | |
1209 "Return the foreground color name of FACE, or nil if unspecified. | |
1210 See documentation for `face-foreground' for a description of the | |
1211 arguments FACE, FRAME, and INHERIT. | |
1212 | |
1213 Calls `face-foreground' correctly in older environments. Versions | |
1214 of Emacs prior to version 22 lacked an INHERIT argument which | |
1215 when t tells `face-foreground' to consider an inherited value for | |
1216 the foreground if the face does not define one itself." | |
1217 (if (>= emacs-major-version 22) | |
1218 `(face-foreground ,face ,frame ,inherit) | |
1219 `(face-foreground ,face ,frame))) | |
1220 | |
1221 (defmacro mh-face-background-compat (face &optional frame inherit) | |
1222 "Return the background color name of face, or nil if unspecified. | |
1223 See documentation for `back-foreground' for a description of the | |
1224 arguments FACE, FRAME, and INHERIT. | |
1225 | |
1226 Calls `face-background' correctly in older environments. Versions | |
1227 of Emacs prior to version 22 lacked an INHERIT argument which | |
1228 when t tells `face-background' to consider an inherited value for | |
1229 the background if the face does not define one itself." | |
1230 (if (>= emacs-major-version 22) | |
1231 `(face-background ,face ,frame ,inherit) | |
1232 `(face-background ,face ,frame))) | |
1233 | |
1234 (defun mh-face-display-function () | |
1235 "Display a Face, X-Face, or X-Image-URL header field. | |
1236 If more than one of these are present, then the first one found | |
1237 in this order is used." | |
1238 (save-restriction | |
1239 (goto-char (point-min)) | |
1240 (re-search-forward "\n\n" (point-max) t) | |
1241 (narrow-to-region (point-min) (point)) | |
1242 (let* ((case-fold-search t) | |
1243 (default-enable-multibyte-characters nil) | |
1244 (face (message-fetch-field "face" t)) | |
1245 (x-face (message-fetch-field "x-face" t)) | |
1246 (url (message-fetch-field "x-image-url" t)) | |
1247 raw type) | |
1248 (cond (face (setq raw (mh-face-to-png face) | |
1249 type 'png)) | |
1250 (x-face (setq raw (mh-uncompface x-face) | |
1251 type 'pbm)) | |
1252 (url (setq type 'url)) | |
1253 (t (multiple-value-setq (type raw) (mh-picon-get-image)))) | |
1254 (when type | |
1255 (goto-char (point-min)) | |
1256 (when (re-search-forward "^from:" (point-max) t) | |
1257 ;; GNU Emacs | |
1258 (mh-do-in-gnu-emacs | |
1259 (if (eq type 'url) | |
1260 (mh-x-image-url-display url) | |
1261 (mh-funcall-if-exists | |
1262 insert-image (create-image | |
1263 raw type t | |
1264 :foreground | |
1265 (mh-face-foreground-compat 'mh-show-xface nil t) | |
1266 :background | |
1267 (mh-face-background-compat 'mh-show-xface nil t)) | |
1268 " "))) | |
1269 ;; XEmacs | |
1270 (mh-do-in-xemacs | |
1271 (cond | |
1272 ((eq type 'url) | |
1273 (mh-x-image-url-display url)) | |
1274 ((eq type 'png) | |
1275 (when (featurep 'png) | |
1276 (set-extent-begin-glyph | |
1277 (make-extent (point) (point)) | |
1278 (make-glyph (vector 'png ':data (mh-face-to-png face)))))) | |
1279 ;; Try internal xface support if available... | |
1280 ((and (eq type 'pbm) (featurep 'xface)) | |
1281 (set-glyph-face | |
1282 (set-extent-begin-glyph | |
1283 (make-extent (point) (point)) | |
1284 (make-glyph (vector 'xface ':data (concat "X-Face: " x-face)))) | |
1285 'mh-show-xface)) | |
1286 ;; Otherwise try external support with x-face... | |
1287 ((and (eq type 'pbm) | |
1288 (fboundp 'x-face-xmas-wl-display-x-face) | |
1289 (fboundp 'executable-find) (executable-find "uncompface")) | |
1290 (mh-funcall-if-exists x-face-xmas-wl-display-x-face)) | |
1291 ;; Picon display | |
1292 ((and raw (member type '(xpm xbm gif))) | |
1293 (when (featurep type) | |
1294 (set-extent-begin-glyph | |
1295 (make-extent (point) (point)) | |
1296 (make-glyph (vector type ':data raw)))))) | |
1297 (when raw (insert " ")))))))) | |
1298 | |
1299 (defun mh-show-xface () | |
1300 "Display X-Face." | |
1301 (when (and window-system mh-show-use-xface-flag | |
1302 (or mh-decode-mime-flag mh-mhl-format-file | |
1303 mh-clean-message-header-flag)) | |
1304 (funcall mh-show-xface-function))) | |
1305 | |
1306 | |
1307 | |
1308 ;;; Picon display | |
1309 | |
1310 ;; XXX: This should be customizable. As a side-effect of setting this | |
1311 ;; variable, arrange to reset mh-picon-existing-directory-list to 'unset. | |
1312 (defvar mh-picon-directory-list | |
1313 '("~/.picons" "~/.picons/users" "~/.picons/usenix" "~/.picons/news" | |
1314 "~/.picons/domains" "~/.picons/misc" | |
1315 "/usr/share/picons/" "/usr/share/picons/users" "/usr/share/picons/usenix" | |
1316 "/usr/share/picons/news" "/usr/share/picons/domains" | |
1317 "/usr/share/picons/misc") | |
1318 "List of directories where picons reside. | |
1319 The directories are searched for in the order they appear in the list.") | |
1320 | |
1321 (defvar mh-picon-existing-directory-list 'unset | |
1322 "List of directories to search in.") | |
1323 | |
1324 (defvar mh-picon-cache (make-hash-table :test #'equal)) | |
1325 | |
1326 (defvar mh-picon-image-types | |
1327 (loop for type in '(xpm xbm gif) | |
1328 when (or (mh-do-in-gnu-emacs | |
1329 (ignore-errors | |
1330 (mh-funcall-if-exists image-type-available-p type))) | |
1331 (mh-do-in-xemacs (featurep type))) | |
1332 collect type)) | |
1333 | |
1334 (defun mh-picon-set-directory-list () | |
1335 "Update `mh-picon-existing-directory-list' if needed." | |
1336 (when (eq mh-picon-existing-directory-list 'unset) | |
1337 (setq mh-picon-existing-directory-list | |
1338 (loop for x in mh-picon-directory-list | |
1339 when (file-directory-p x) collect x)))) | |
1340 | |
1341 (defun* mh-picon-get-image () | |
1342 "Find the best possible match and return contents." | |
1343 (mh-picon-set-directory-list) | |
1344 (save-restriction | |
1345 (let* ((from-field (ignore-errors (car (message-tokenize-header | |
1346 (mh-get-header-field "from:"))))) | |
1347 (from (car (ignore-errors | |
1348 (mh-funcall-if-exists ietf-drums-parse-address | |
1349 from-field)))) | |
1350 (host (and from | |
1351 (string-match "\\([^+]*\\)\\(+.*\\)?@\\(.*\\)" from) | |
1352 (downcase (match-string 3 from)))) | |
1353 (user (and host (downcase (match-string 1 from)))) | |
1354 (canonical-address (format "%s@%s" user host)) | |
1355 (cached-value (gethash canonical-address mh-picon-cache)) | |
1356 (host-list (and host (delete "" (split-string host "\\.")))) | |
1357 (match nil)) | |
1358 (cond (cached-value (return-from mh-picon-get-image cached-value)) | |
1359 ((not host-list) (return-from mh-picon-get-image nil))) | |
1360 (setq match | |
1361 (block 'loop | |
1362 ;; u@h search | |
1363 (loop for dir in mh-picon-existing-directory-list | |
1364 do (loop for type in mh-picon-image-types | |
1365 ;; [path]user@host | |
1366 for file1 = (format "%s/%s.%s" | |
1367 dir canonical-address type) | |
1368 when (file-exists-p file1) | |
1369 do (return-from 'loop file1) | |
1370 ;; [path]user | |
1371 for file2 = (format "%s/%s.%s" dir user type) | |
1372 when (file-exists-p file2) | |
1373 do (return-from 'loop file2) | |
1374 ;; [path]host | |
1375 for file3 = (format "%s/%s.%s" dir host type) | |
1376 when (file-exists-p file3) | |
1377 do (return-from 'loop file3))) | |
1378 ;; facedb search | |
1379 ;; Search order for user@foo.net: | |
1380 ;; [path]net/foo/user | |
1381 ;; [path]net/foo/user/face | |
1382 ;; [path]net/user | |
1383 ;; [path]net/user/face | |
1384 ;; [path]net/foo/unknown | |
1385 ;; [path]net/foo/unknown/face | |
1386 ;; [path]net/unknown | |
1387 ;; [path]net/unknown/face | |
1388 (loop for u in (list user "unknown") | |
1389 do (loop for dir in mh-picon-existing-directory-list | |
1390 do (loop for x on host-list by #'cdr | |
1391 for y = (mh-picon-generate-path x u dir) | |
1392 do (loop for type in mh-picon-image-types | |
1393 for z1 = (format "%s.%s" y type) | |
1394 when (file-exists-p z1) | |
1395 do (return-from 'loop z1) | |
1396 for z2 = (format "%s/face.%s" | |
1397 y type) | |
1398 when (file-exists-p z2) | |
1399 do (return-from 'loop z2))))))) | |
1400 (setf (gethash canonical-address mh-picon-cache) | |
1401 (mh-picon-file-contents match))))) | |
1402 | |
1403 (defun mh-picon-file-contents (file) | |
1404 "Return details about FILE. | |
1405 A list of consisting of a symbol for the type of the file and the | |
1406 file contents as a string is returned. If FILE is nil, then both | |
1407 elements of the list are nil." | |
1408 (if (stringp file) | |
1409 (with-temp-buffer | |
1410 (let ((type (and (string-match ".*\\.\\(...\\)$" file) | |
1411 (intern (match-string 1 file))))) | |
1412 (insert-file-contents-literally file) | |
1413 (values type (buffer-string)))) | |
1414 (values nil nil))) | |
1415 | |
1416 (defun mh-picon-generate-path (host-list user directory) | |
1417 "Generate the image file path. | |
1418 HOST-LIST is the parsed host address of the email address, USER | |
1419 the username and DIRECTORY is the directory relative to which the | |
1420 path is generated." | |
1421 (loop with acc = "" | |
1422 for elem in host-list | |
1423 do (setq acc (format "%s/%s" elem acc)) | |
1424 finally return (format "%s/%s%s" directory acc user))) | |
1425 | |
1426 | |
1427 | |
1428 ;; X-Image-URL display | |
1429 | |
1430 (defvar mh-x-image-cache-directory nil | |
1431 "Directory where X-Image-URL images are cached.") | |
1432 (defvar mh-x-image-scaling-function | |
1433 (cond ((executable-find "convert") | |
1434 'mh-x-image-scale-with-convert) | |
1435 ((and (executable-find "anytopnm") (executable-find "pnmscale") | |
1436 (executable-find "pnmtopng")) | |
1437 'mh-x-image-scale-with-pnm) | |
1438 (t 'ignore)) | |
1439 "Function to use to scale image to proper size.") | |
1440 (defvar mh-wget-executable nil) | |
1441 (defvar mh-wget-choice | |
1442 (or (and (setq mh-wget-executable (executable-find "wget")) 'wget) | |
1443 (and (setq mh-wget-executable (executable-find "fetch")) 'fetch) | |
1444 (and (setq mh-wget-executable (executable-find "curl")) 'curl))) | |
1445 (defvar mh-wget-option | |
1446 (cdr (assoc mh-wget-choice '((curl . "-o") (fetch . "-o") (wget . "-O"))))) | |
1447 (defvar mh-x-image-temp-file nil) | |
1448 (defvar mh-x-image-url nil) | |
1449 (defvar mh-x-image-marker nil) | |
1450 (defvar mh-x-image-url-cache-file nil) | |
1451 | |
1452 ;; Functions to scale image to proper size | |
1453 (defun mh-x-image-scale-with-pnm (input output) | |
1454 "Scale image in INPUT file and write to OUTPUT file using pnm tools." | |
1455 (let ((res (shell-command-to-string | |
1456 (format "anytopnm < %s | pnmscale -xysize 96 48 | pnmtopng > %s" | |
1457 input output)))) | |
1458 (unless (equal res "") | |
1459 (delete-file output)))) | |
1460 | |
1461 (defun mh-x-image-scale-with-convert (input output) | |
1462 "Scale image in INPUT file and write to OUTPUT file using ImageMagick." | |
1463 (call-process "convert" nil nil nil "-geometry" "96x48" input output)) | |
1464 | |
1465 ;; Copy of constant from url-util.el in Emacs 22; needed by Emacs 21. | |
1466 (if (not (boundp 'url-unreserved-chars)) | |
1467 (defconst url-unreserved-chars | |
1468 '( | |
1469 ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z | |
1470 ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z | |
1471 ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 | |
1472 ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\)) | |
1473 "A list of characters that are _NOT_ reserved in the URL spec. | |
1474 This is taken from RFC 2396.")) | |
1475 | |
1476 ;; Copy of function from url-util.el in Emacs 22; needed by Emacs 21. | |
1477 (mh-defun-compat url-hexify-string (str) | |
1478 "Escape characters in a string." | |
1479 (mapconcat | |
1480 (lambda (char) | |
1481 ;; Fixme: use a char table instead. | |
1482 (if (not (memq char url-unreserved-chars)) | |
1483 (if (> char 255) | |
1484 (error "Hexifying multibyte character %s" str) | |
1485 (format "%%%02X" char)) | |
1486 (char-to-string char))) | |
1487 str "")) | |
1488 | |
1489 (defun mh-x-image-url-cache-canonicalize (url) | |
1490 "Canonicalize URL. | |
1491 Replace the ?/ character with a ?! character and append .png. | |
1492 Also replaces special characters with `url-hexify-string' since | |
1493 not all characters, such as :, are legal within Windows | |
1494 filenames. See URL `http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp'." | |
1495 (format "%s/%s.png" mh-x-image-cache-directory | |
1496 (url-hexify-string | |
1497 (with-temp-buffer | |
1498 (insert url) | |
1499 (mh-replace-string "/" "!") | |
1500 (buffer-string))))) | |
1501 | |
1502 (defun mh-x-image-set-download-state (file data) | |
1503 "Setup a symbolic link from FILE to DATA." | |
1504 (if data | |
1505 (make-symbolic-link (symbol-name data) file t) | |
1506 (delete-file file))) | |
1507 | |
1508 (defun mh-x-image-get-download-state (file) | |
1509 "Check the state of FILE by following any symbolic links." | |
1510 (unless (file-exists-p mh-x-image-cache-directory) | |
1511 (call-process "mkdir" nil nil nil mh-x-image-cache-directory)) | |
1512 (cond ((file-symlink-p file) | |
1513 (intern (file-name-nondirectory (file-chase-links file)))) | |
1514 ((not (file-exists-p file)) nil) | |
1515 (t 'ok))) | |
1516 | |
1517 (defun mh-x-image-url-fetch-image (url cache-file marker sentinel) | |
1518 "Fetch and display the image specified by URL. | |
1519 After the image is fetched, it is stored in CACHE-FILE. It will | |
1520 be displayed in a buffer and position specified by MARKER. The | |
1521 actual display is carried out by the SENTINEL function." | |
1522 (if mh-wget-executable | |
1523 (let ((buffer (get-buffer-create (generate-new-buffer-name | |
1524 mh-temp-fetch-buffer))) | |
1525 (filename (or (mh-funcall-if-exists make-temp-file "mhe-fetch") | |
1526 (expand-file-name (make-temp-name "~/mhe-fetch"))))) | |
1527 (save-excursion | |
1528 (set-buffer buffer) | |
1529 (set (make-local-variable 'mh-x-image-url-cache-file) cache-file) | |
1530 (set (make-local-variable 'mh-x-image-marker) marker) | |
1531 (set (make-local-variable 'mh-x-image-temp-file) filename)) | |
1532 (set-process-sentinel | |
1533 (start-process "*mh-x-image-url-fetch*" buffer | |
1534 mh-wget-executable mh-wget-option filename url) | |
1535 sentinel)) | |
1536 ;; Temporary failure | |
1537 (mh-x-image-set-download-state cache-file 'try-again))) | |
1538 | |
1539 (defun mh-x-image-display (image marker) | |
1540 "Display IMAGE at MARKER." | |
1541 (save-excursion | |
1542 (set-buffer (marker-buffer marker)) | |
1543 (let ((buffer-read-only nil) | |
1544 (default-enable-multibyte-characters nil) | |
1545 (buffer-modified-flag (buffer-modified-p))) | |
1546 (unwind-protect | |
1547 (when (and (file-readable-p image) (not (file-symlink-p image)) | |
1548 (eq marker mh-x-image-marker)) | |
1549 (goto-char marker) | |
1550 (mh-do-in-gnu-emacs | |
1551 (mh-funcall-if-exists insert-image (create-image image 'png))) | |
1552 (mh-do-in-xemacs | |
1553 (when (featurep 'png) | |
1554 (set-extent-begin-glyph | |
1555 (make-extent (point) (point)) | |
1556 (make-glyph | |
1557 (vector 'png ':data (with-temp-buffer | |
1558 (insert-file-contents-literally image) | |
1559 (buffer-string)))))))) | |
1560 (set-buffer-modified-p buffer-modified-flag))))) | |
1561 | |
1562 (defun mh-x-image-scale-and-display (process change) | |
1563 "When the wget PROCESS terminates scale and display image. | |
1564 The argument CHANGE is ignored." | |
1565 (when (eq (process-status process) 'exit) | |
1566 (let (marker temp-file cache-filename wget-buffer) | |
1567 (save-excursion | |
1568 (set-buffer (setq wget-buffer (process-buffer process))) | |
1569 (setq marker mh-x-image-marker | |
1570 cache-filename mh-x-image-url-cache-file | |
1571 temp-file mh-x-image-temp-file)) | |
1572 (cond | |
1573 ;; Check if we have `convert' | |
1574 ((eq mh-x-image-scaling-function 'ignore) | |
1575 (message "The \"convert\" program is needed to display X-Image-URL") | |
1576 (mh-x-image-set-download-state cache-filename 'try-again)) | |
1577 ;; Scale fetched image | |
1578 ((and (funcall mh-x-image-scaling-function temp-file cache-filename) | |
1579 nil)) | |
1580 ;; Attempt to display image if we have it | |
1581 ((file-exists-p cache-filename) | |
1582 (mh-x-image-display cache-filename marker)) | |
1583 ;; We didn't find the image. Should we try to display it the next time? | |
1584 (t (mh-x-image-set-download-state cache-filename 'try-again))) | |
1585 (ignore-errors | |
1586 (set-marker marker nil) | |
1587 (delete-process process) | |
1588 (kill-buffer wget-buffer) | |
1589 (delete-file temp-file))))) | |
1590 | |
1591 (defun mh-x-image-url-sane-p (url) | |
1592 "Check if URL is something sensible." | |
1593 (let ((len (length url))) | |
1594 (cond ((< len 5) nil) | |
1595 ((not (equal (substring url 0 5) "http:")) nil) | |
1596 ((> len 100) nil) | |
1597 (t t)))) | |
1598 | |
1599 (defun mh-x-image-url-display (url) | |
1600 "Display image from location URL. | |
1601 If the URL isn't present in the cache then it is fetched with wget." | |
1602 (let* ((cache-filename (mh-x-image-url-cache-canonicalize url)) | |
1603 (state (mh-x-image-get-download-state cache-filename)) | |
1604 (marker (set-marker (make-marker) (point)))) | |
1605 (set (make-local-variable 'mh-x-image-marker) marker) | |
1606 (cond ((not (mh-x-image-url-sane-p url))) | |
1607 ((eq state 'ok) | |
1608 (mh-x-image-display cache-filename marker)) | |
1609 ((or (not mh-wget-executable) | |
1610 (eq mh-x-image-scaling-function 'ignore))) | |
1611 ((eq state 'never)) | |
1612 ((not mh-fetch-x-image-url) | |
1613 (set-marker marker nil)) | |
1614 ((eq state 'try-again) | |
1615 (mh-x-image-set-download-state cache-filename nil) | |
1616 (mh-x-image-url-fetch-image url cache-filename marker | |
1617 'mh-x-image-scale-and-display)) | |
1618 ((and (eq mh-fetch-x-image-url 'ask) | |
1619 (not (y-or-n-p (format "Fetch %s? " url)))) | |
1620 (mh-x-image-set-download-state cache-filename 'never)) | |
1621 ((eq state nil) | |
1622 (mh-x-image-url-fetch-image url cache-filename marker | |
1623 'mh-x-image-scale-and-display))))) | |
1624 | |
1625 | |
1626 | |
1627 (defun mh-maybe-show (&optional msg) | |
1628 "Display message at cursor, but only if in show mode. | |
1629 If optional arg MSG is non-nil, display that message instead." | |
1630 (if mh-showing-mode (mh-show msg))) | |
1631 | |
1632 (defun mh-show (&optional message redisplay-flag) | |
1633 "Display message\\<mh-folder-mode-map>. | |
1634 | |
1635 If the message under the cursor is already displayed, this command | |
1636 scrolls to the beginning of the message. MH-E normally hides a lot of | |
1637 the superfluous header fields that mailers add to a message, but if | |
1638 you wish to see all of them, use the command \\[mh-header-display]. | |
1639 | |
1640 Two hooks can be used to control how messages are displayed. The | |
1641 first hook, `mh-show-mode-hook', is called early on in the | |
1642 process of the message display. It is usually used to perform | |
1643 some action on the message's content. The second hook, | |
1644 `mh-show-hook', is the last thing called after messages are | |
1645 displayed. It's used to affect the behavior of MH-E in general or | |
1646 when `mh-show-mode-hook' is too early. | |
1647 | |
1648 From a program, optional argument MESSAGE can be used to display an | |
1649 alternative message. The optional argument REDISPLAY-FLAG forces the | |
1650 redisplay of the message even if the show buffer was already | |
1651 displaying the correct message. | |
1652 | |
1653 See the \"mh-show\" customization group for a litany of options that | |
1654 control what displayed messages look like." | |
1655 (interactive (list nil t)) | |
1656 (when (or redisplay-flag | |
1657 (and mh-showing-with-headers | |
1658 (or mh-mhl-format-file mh-clean-message-header-flag))) | |
1659 (mh-invalidate-show-buffer)) | |
1660 (mh-show-msg message)) | |
1661 | |
1662 (defun mh-show-mouse (event) | |
1663 "Move point to mouse EVENT and show message." | |
1664 (interactive "e") | |
1665 (mouse-set-point event) | |
1666 (mh-show)) | |
1667 | |
1668 (defun mh-summary-height () | |
1669 "Return ideal value for the variable `mh-summary-height'. | |
1670 The current frame height is taken into consideration." | |
1671 (or (and (fboundp 'frame-height) | |
1672 (> (frame-height) 24) | |
1673 (min 10 (/ (frame-height) 6))) | |
1674 4)) | |
1675 | |
1676 (defun mh-show-msg (msg) | |
1677 "Show MSG. | |
1678 | |
1679 The hook `mh-show-hook' is called after the message has been | |
1680 displayed." | |
1681 (if (not msg) | |
1682 (setq msg (mh-get-msg-num t))) | |
1683 (mh-showing-mode t) | |
1684 (setq mh-page-to-next-msg-flag nil) | |
1685 (let ((folder mh-current-folder) | |
1686 (folders (list mh-current-folder)) | |
1687 (clean-message-header mh-clean-message-header-flag) | |
1688 (show-window (get-buffer-window mh-show-buffer)) | |
1689 (display-mime-buttons-flag mh-display-buttons-for-inline-parts-flag)) | |
1690 (if (not (eq (next-window (minibuffer-window)) (selected-window))) | |
1691 (delete-other-windows)) ; force ourself to the top window | |
1692 (mh-in-show-buffer (mh-show-buffer) | |
1693 (setq mh-display-buttons-for-inline-parts-flag display-mime-buttons-flag) | |
1694 (if (and show-window | |
1695 (equal (mh-msg-filename msg folder) buffer-file-name)) | |
1696 (progn ;just back up to start | |
1697 (goto-char (point-min)) | |
1698 (if (not clean-message-header) | |
1699 (mh-start-of-uncleaned-message))) | |
1700 (mh-display-msg msg folder))) | |
1701 (if (not (= (1+ (window-height)) (frame-height))) ;not horizontally split | |
1702 (shrink-window (- (window-height) (or mh-summary-height | |
1703 (mh-summary-height))))) | |
1704 (mh-recenter nil) | |
1705 ;; The following line is a nop which forces update of the scan line so | |
1706 ;; that font-lock will update it (if needed)... | |
1707 (mh-notate nil nil mh-cmd-note) | |
1708 (if (not (memq msg mh-seen-list)) | |
1709 (setq mh-seen-list (cons msg mh-seen-list))) | |
1710 (when mh-update-sequences-after-mh-show-flag | |
1711 (mh-update-sequences) | |
1712 (when mh-index-data | |
1713 (setq folders | |
1714 (append (mh-index-delete-from-sequence mh-unseen-seq (list msg)) | |
1715 folders))) | |
1716 (when (mh-speed-flists-active-p) | |
1717 (apply #'mh-speed-flists t folders))) | |
1718 (run-hooks 'mh-show-hook))) | |
1719 | |
1720 (defun mh-modify (&optional message) | |
1721 "Edit message. | |
1722 | |
1723 There are times when you need to edit a message. For example, you | |
1724 may need to fix a broken Content-Type header field. You can do | |
1725 this with this command. It displays the raw message in an | |
1726 editable buffer. When you are done editing, save and kill the | |
1727 buffer as you would any other. | |
1728 | |
1729 From a program, edit MESSAGE; nil means edit current message." | |
1730 (interactive) | |
1731 (let* ((message (or message (mh-get-msg-num t))) | |
1732 (msg-filename (mh-msg-filename message)) | |
1733 edit-buffer) | |
1734 (when (not (file-exists-p msg-filename)) | |
1735 (error "Message %d does not exist" message)) | |
1736 | |
1737 ;; Invalidate the show buffer if it is showing the same message that is | |
1738 ;; to be edited. | |
1739 (when (and (buffer-live-p (get-buffer mh-show-buffer)) | |
1740 (equal (save-excursion (set-buffer mh-show-buffer) | |
1741 buffer-file-name) | |
1742 msg-filename)) | |
1743 (mh-invalidate-show-buffer)) | |
1744 | |
1745 ;; Edit message | |
1746 (find-file msg-filename) | |
1747 (setq edit-buffer (current-buffer)) | |
1748 | |
1749 ;; Set buffer properties | |
1750 (mh-letter-mode) | |
1751 (use-local-map text-mode-map) | |
1752 | |
1753 ;; Just show the edit buffer... | |
1754 (delete-other-windows) | |
1755 (switch-to-buffer edit-buffer))) | |
1756 | |
1757 (defun mh-show-unquote-From () | |
1758 "Decode >From at beginning of lines for `mh-show-mode'." | |
1759 (save-excursion | |
1760 (let ((modified (buffer-modified-p)) | |
1761 (case-fold-search nil) | |
1762 (buffer-read-only nil)) | |
1763 (goto-char (mh-mail-header-end)) | |
1764 (while (re-search-forward "^>From" nil t) | |
1765 (replace-match "From")) | |
1766 (set-buffer-modified-p modified)))) | |
1767 | |
1768 (defun mh-msg-folder (folder-name) | |
1769 "Return the name of the buffer for FOLDER-NAME." | |
1770 folder-name) | |
1771 | |
1772 (defun mh-display-msg (msg-num folder-name) | |
1773 "Display MSG-NUM of FOLDER-NAME. | |
1774 Sets the current buffer to the show buffer." | |
1775 (let ((folder (mh-msg-folder folder-name))) | |
1776 (set-buffer folder) | |
1777 ;; When Gnus uses external displayers it has to keep handles longer. So | |
1778 ;; we will delete these handles when mh-quit is called on the folder. It | |
1779 ;; would be nicer if there are weak pointers in emacs lisp, then we could | |
1780 ;; get the garbage collector to do this for us. | |
1781 (unless (mh-buffer-data) | |
1782 (setf (mh-buffer-data) (mh-make-buffer-data))) | |
1783 ;; Bind variables in folder buffer in case they are local | |
1784 (let ((formfile mh-mhl-format-file) | |
1785 (clean-message-header mh-clean-message-header-flag) | |
1786 (invisible-headers mh-invisible-header-fields-compiled) | |
1787 (visible-headers nil) | |
1788 (msg-filename (mh-msg-filename msg-num folder-name)) | |
1789 (show-buffer mh-show-buffer) | |
1790 (mm-inline-media-tests mh-mm-inline-media-tests)) | |
1791 (if (not (file-exists-p msg-filename)) | |
1792 (error "Message %d does not exist" msg-num)) | |
1793 (if (and (> mh-show-maximum-size 0) | |
1794 (> (elt (file-attributes msg-filename) 7) | |
1795 mh-show-maximum-size) | |
1796 (not (y-or-n-p | |
1797 (format | |
1798 "Message %d (%d bytes) exceeds %d bytes. Display it? " | |
1799 msg-num (elt (file-attributes msg-filename) 7) | |
1800 mh-show-maximum-size)))) | |
1801 (error "Message %d not displayed" msg-num)) | |
1802 (set-buffer show-buffer) | |
1803 (cond ((not (equal msg-filename buffer-file-name)) | |
1804 (mh-unvisit-file) | |
1805 (setq buffer-read-only nil) | |
1806 ;; Cleanup old mime handles | |
1807 (mh-mime-cleanup) | |
1808 (erase-buffer) | |
1809 ;; Changing contents, so this hook needs to be reinitialized. | |
1810 ;; pgp.el uses this. | |
1811 (if (boundp 'write-contents-hooks) ;Emacs 19 | |
1812 (kill-local-variable 'write-contents-hooks)) | |
1813 (if formfile | |
1814 (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear" | |
1815 (if (stringp formfile) | |
1816 (list "-form" formfile)) | |
1817 msg-filename) | |
1818 (insert-file-contents-literally msg-filename)) | |
1819 ;; Use mm to display buffer | |
1820 (when (and mh-decode-mime-flag (not formfile)) | |
1821 (mh-add-missing-mime-version-header) | |
1822 (setf (mh-buffer-data) (mh-make-buffer-data)) | |
1823 (mh-mime-display)) | |
1824 (mh-show-mode) | |
1825 ;; Header cleanup | |
1826 (goto-char (point-min)) | |
1827 (cond (clean-message-header | |
1828 (mh-clean-msg-header (point-min) | |
1829 invisible-headers | |
1830 visible-headers) | |
1831 (goto-char (point-min))) | |
1832 (t | |
1833 (mh-start-of-uncleaned-message))) | |
1834 (mh-decode-message-header) | |
1835 ;; the parts of visiting we want to do (no locking) | |
1836 (or (eq buffer-undo-list t) ;don't save undo info for prev msgs | |
1837 (setq buffer-undo-list nil)) | |
1838 (set-buffer-auto-saved) | |
1839 ;; the parts of set-visited-file-name we want to do (no locking) | |
1840 (setq buffer-file-name msg-filename) | |
1841 (setq buffer-backed-up nil) | |
1842 (auto-save-mode 1) | |
1843 (set-mark nil) | |
1844 (unwind-protect | |
1845 (when (and mh-decode-mime-flag (not formfile)) | |
1846 (setq buffer-read-only nil) | |
1847 (mh-display-smileys) | |
1848 (mh-display-emphasis)) | |
1849 (setq buffer-read-only t)) | |
1850 (set-buffer-modified-p nil) | |
1851 (setq mh-show-folder-buffer folder) | |
1852 (setq mode-line-buffer-identification | |
1853 (list (format mh-show-buffer-mode-line-buffer-id | |
1854 folder-name msg-num))) | |
1855 (mh-logo-display) | |
1856 (set-buffer folder) | |
1857 (setq mh-showing-with-headers nil)))))) | |
1858 | |
1859 (defun mh-clean-msg-header (start invisible-headers visible-headers) | |
1860 "Flush extraneous lines in message header. | |
1861 | |
1862 Header is cleaned from START to the end of the message header. | |
1863 INVISIBLE-HEADERS contains a regular expression specifying lines | |
1864 to delete from the header. VISIBLE-HEADERS contains a regular | |
1865 expression specifying the lines to display. INVISIBLE-HEADERS is | |
1866 ignored if VISIBLE-HEADERS is non-nil." | |
1867 ;; XXX Note that MH-E no longer supports the `mh-visible-headers' | |
1868 ;; variable, so this function could be trimmed of this feature too." | |
1869 (let ((case-fold-search t) | |
1870 (buffer-read-only nil)) | |
1871 (save-restriction | |
1872 (goto-char start) | |
1873 (if (search-forward "\n\n" nil 'move) | |
1874 (backward-char 1)) | |
1875 (narrow-to-region start (point)) | |
1876 (goto-char (point-min)) | |
1877 (if visible-headers | |
1878 (while (< (point) (point-max)) | |
1879 (cond ((looking-at visible-headers) | |
1880 (forward-line 1) | |
1881 (while (looking-at "[ \t]") (forward-line 1))) | |
1882 (t | |
1883 (mh-delete-line 1) | |
1884 (while (looking-at "[ \t]") | |
1885 (mh-delete-line 1))))) | |
1886 (while (re-search-forward invisible-headers nil t) | |
1887 (beginning-of-line) | |
1888 (mh-delete-line 1) | |
1889 (while (looking-at "[ \t]") | |
1890 (mh-delete-line 1))))) | |
1891 (let ((mh-compose-skipped-header-fields ())) | |
1892 (mh-letter-hide-all-skipped-fields)) | |
1893 (unlock-buffer))) | |
1894 | |
1895 (defun mh-delete-line (lines) | |
1896 "Delete the next LINES lines." | |
1897 (delete-region (point) (progn (forward-line lines) (point)))) | |
1898 | |
1899 (defun mh-notate (msg notation offset) | |
1900 "Mark MSG with the character NOTATION at position OFFSET. | |
1901 Null MSG means the message at cursor. | |
1902 If NOTATION is nil then no change in the buffer occurs." | |
1903 (save-excursion | |
1904 (if (or (null msg) | |
1905 (mh-goto-msg msg t t)) | |
1906 (with-mh-folder-updating (t) | |
1907 (beginning-of-line) | |
1908 (forward-char offset) | |
1909 (let* ((change-stack-flag | |
1910 (and (equal offset | |
1911 (+ mh-cmd-note mh-scan-field-destination-offset)) | |
1912 (not (eq notation mh-note-seq)))) | |
1913 (msg (and change-stack-flag (or msg (mh-get-msg-num nil)))) | |
1914 (stack (and msg (gethash msg mh-sequence-notation-history))) | |
1915 (notation (or notation (char-after)))) | |
1916 (if stack | |
1917 ;; The presence of the stack tells us that we don't need to | |
1918 ;; notate the message, since the notation would be replaced | |
1919 ;; by a sequence notation. So we will just put the notation | |
1920 ;; at the bottom of the stack. If the sequence is deleted, | |
1921 ;; the correct notation will be shown. | |
1922 (setf (gethash msg mh-sequence-notation-history) | |
1923 (reverse (cons notation (cdr (reverse stack))))) | |
1924 ;; Since we don't have any sequence notations in the way, just | |
1925 ;; notate the scan line. | |
1926 (delete-char 1) | |
1927 (insert notation)) | |
1928 (when change-stack-flag | |
1929 (mh-thread-update-scan-line-map msg notation offset))))))) | |
1930 | |
1931 (defun mh-goto-msg (number &optional no-error-if-no-message dont-show) | |
1932 "Go to a message\\<mh-folder-mode-map>. | |
1933 | |
1934 You can enter the message NUMBER either before or after typing | |
1935 \\[mh-goto-msg]. In the latter case, Emacs prompts you. | |
1936 | |
1937 In a program, optional non-nil second argument NO-ERROR-IF-NO-MESSAGE | |
1938 means return nil instead of signaling an error if message does not | |
1939 exist\; in this case, the cursor is positioned near where the message | |
1940 would have been. Non-nil third argument DONT-SHOW means not to show | |
1941 the message." | |
1942 (interactive "NGo to message: ") | |
1943 (setq number (prefix-numeric-value number)) | |
1944 (let ((point (point)) | |
1945 (return-value t)) | |
1946 (goto-char (point-min)) | |
1947 (unless (re-search-forward (format mh-scan-msg-search-regexp number) nil t) | |
1948 (goto-char point) | |
1949 (unless no-error-if-no-message | |
1950 (error "No message %d" number)) | |
1951 (setq return-value nil)) | |
1952 (beginning-of-line) | |
1953 (or dont-show (not return-value) (mh-maybe-show number)) | |
1954 return-value)) | |
1955 | |
1956 (defun mh-set-folder-modified-p (flag) | |
1957 "Mark current folder as modified or unmodified according to FLAG." | |
1958 (set-buffer-modified-p flag)) | |
1959 | |
1960 (defun mh-find-seq (name) | |
1961 "Return sequence NAME." | |
1962 (assoc name mh-seq-list)) | |
1963 | |
1964 (defun mh-seq-to-msgs (seq) | |
1965 "Return a list of the messages in SEQ." | |
1966 (mh-seq-msgs (mh-find-seq seq))) | |
1967 | |
1968 (defun mh-update-scan-format (fmt width) | |
1969 "Return a scan format with the (msg) width in the FMT replaced with WIDTH. | |
1970 | |
1971 The message number width portion of the format is discovered | |
1972 using `mh-scan-msg-format-regexp'. Its replacement is controlled | |
1973 with `mh-scan-msg-format-string'." | |
1974 (or (and | |
1975 (string-match mh-scan-msg-format-regexp fmt) | |
1976 (let ((begin (match-beginning 1)) | |
1977 (end (match-end 1))) | |
1978 (concat (substring fmt 0 begin) | |
1979 (format mh-scan-msg-format-string width) | |
1980 (substring fmt end)))) | |
1981 fmt)) | |
1982 | |
1983 (defun mh-msg-num-width (folder) | |
1984 "Return the width of the largest message number in this FOLDER." | |
1985 (or mh-progs (mh-find-path)) | |
1986 (let ((tmp-buffer (get-buffer-create mh-temp-buffer)) | |
1987 (width 0)) | |
1988 (save-excursion | |
1989 (set-buffer tmp-buffer) | |
1990 (erase-buffer) | |
1991 (apply 'call-process | |
1992 (expand-file-name mh-scan-prog mh-progs) nil '(t nil) nil | |
1993 (list folder "last" "-format" "%(msg)")) | |
1994 (goto-char (point-min)) | |
1995 (if (re-search-forward mh-scan-msg-number-regexp nil 0 1) | |
1996 (setq width (length (buffer-substring | |
1997 (match-beginning 1) (match-end 1)))))) | |
1998 width)) | |
1999 | |
2000 (defun mh-add-msgs-to-seq (msgs seq &optional internal-flag dont-annotate-flag) | |
2001 "Add MSGS to SEQ. | |
2002 | |
2003 Remove duplicates and keep sequence sorted. If optional | |
2004 INTERNAL-FLAG is non-nil, do not mark the message in the scan | |
2005 listing or inform MH of the addition. | |
2006 | |
2007 If DONT-ANNOTATE-FLAG is non-nil then the annotations in the | |
2008 folder buffer are not updated." | |
2009 (let ((entry (mh-find-seq seq)) | |
2010 (internal-seq-flag (mh-internal-seq seq))) | |
2011 (if (and msgs (atom msgs)) (setq msgs (list msgs))) | |
2012 (if (null entry) | |
2013 (setq mh-seq-list | |
2014 (cons (mh-make-seq seq (mh-canonicalize-sequence msgs)) | |
2015 mh-seq-list)) | |
2016 (if msgs (setcdr entry (mh-canonicalize-sequence | |
2017 (append msgs (mh-seq-msgs entry)))))) | |
2018 (unless internal-flag | |
2019 (mh-add-to-sequence seq msgs) | |
2020 (when (not dont-annotate-flag) | |
2021 (mh-iterate-on-range msg msgs | |
2022 (unless (memq msg (cdr entry)) | |
2023 (mh-add-sequence-notation msg internal-seq-flag))))))) | |
2024 | |
2025 (defun mh-canonicalize-sequence (msgs) | |
2026 "Sort MSGS in decreasing order and remove duplicates." | |
2027 (let* ((sorted-msgs (sort (copy-sequence msgs) '>)) | |
2028 (head sorted-msgs)) | |
2029 (while (cdr head) | |
2030 (if (= (car head) (cadr head)) | |
2031 (setcdr head (cddr head)) | |
2032 (setq head (cdr head)))) | |
2033 sorted-msgs)) | |
2034 | 371 |
2035 (defvar mh-sub-folders-cache (make-hash-table :test #'equal)) | 372 (defvar mh-sub-folders-cache (make-hash-table :test #'equal)) |
2036 (defvar mh-current-folder-name nil) | 373 (defvar mh-current-folder-name nil) |
2037 (defvar mh-flists-partial-line "") | 374 (defvar mh-flists-partial-line "") |
2038 (defvar mh-flists-process nil) | 375 (defvar mh-flists-process nil) |
376 | |
377 ;;;###mh-autoload | |
378 (defun mh-clear-sub-folders-cache () | |
379 "Clear `mh-sub-folders-cache'." | |
380 (clrhash mh-sub-folders-cache)) | |
2039 | 381 |
2040 ;; Initialize mh-sub-folders-cache... | 382 ;; Initialize mh-sub-folders-cache... |
2041 (defun mh-collect-folder-names () | 383 (defun mh-collect-folder-names () |
2042 "Collect folder names by running \"folders\"." | 384 "Collect folder names by running \"folders\"." |
2043 (unless mh-flists-process | 385 (unless mh-flists-process |
2048 (defun mh-collect-folder-names-filter (process output) | 390 (defun mh-collect-folder-names-filter (process output) |
2049 "Read folder names. | 391 "Read folder names. |
2050 PROCESS is the flists process that was run to collect folder | 392 PROCESS is the flists process that was run to collect folder |
2051 names and the function is called when OUTPUT is available." | 393 names and the function is called when OUTPUT is available." |
2052 (let ((position 0) | 394 (let ((position 0) |
2053 (prevailing-match-data (match-data)) | 395 (prevailing-match-data (match-data)) |
2054 line-end folder) | 396 line-end folder) |
2055 (unwind-protect | 397 (unwind-protect |
2056 (while (setq line-end (string-match "\n" output position)) | 398 (while (setq line-end (string-match "\n" output position)) |
2057 (setq folder (format "+%s%s" | 399 (setq folder (format "+%s%s" |
2058 mh-flists-partial-line | 400 mh-flists-partial-line |
2059 (substring output position line-end))) | 401 (substring output position line-end))) |
2060 (setq mh-flists-partial-line "") | 402 (setq mh-flists-partial-line "") |
2061 (unless (equal (aref folder 1) ?.) | 403 (unless (equal (aref folder 1) ?.) |
2062 (mh-populate-sub-folders-cache folder)) | 404 (mh-populate-sub-folders-cache folder)) |
2063 (setq position (1+ line-end))) | 405 (setq position (1+ line-end))) |
2064 (set-match-data prevailing-match-data)) | 406 (set-match-data prevailing-match-data)) |
2065 (setq mh-flists-partial-line (substring output position)))) | 407 (setq mh-flists-partial-line (substring output position)))) |
2066 | 408 |
2067 (defun mh-populate-sub-folders-cache (folder) | 409 (defun mh-populate-sub-folders-cache (folder) |
2068 "Tell `mh-sub-folders-cache' about FOLDER." | 410 "Tell `mh-sub-folders-cache' about FOLDER." |
2146 number of sub-folders. XXX" | 488 number of sub-folders. XXX" |
2147 `(if (cdr ,folder) | 489 `(if (cdr ,folder) |
2148 t | 490 t |
2149 nil)) | 491 nil)) |
2150 | 492 |
493 ;;;###mh-autoload | |
2151 (defun mh-folder-list (folder) | 494 (defun mh-folder-list (folder) |
2152 "Return FOLDER and its descendents. | 495 "Return FOLDER and its descendents. |
2153 Returns a list of strings. For example, | 496 Returns a list of strings. For example, |
2154 | 497 |
2155 '(\"inbox\" \"lists\" \"lists/mh-e\"). | 498 '(\"inbox\" \"lists\" \"lists/mh-e\"). |
2174 (setq folder-list | 517 (setq folder-list |
2175 (append folder-list | 518 (append folder-list |
2176 (mh-folder-list (concat folder (car f))))))) | 519 (mh-folder-list (concat folder (car f))))))) |
2177 folder-list)) | 520 folder-list)) |
2178 | 521 |
522 ;;;###mh-autoload | |
2179 (defun mh-sub-folders (folder &optional add-trailing-slash-flag) | 523 (defun mh-sub-folders (folder &optional add-trailing-slash-flag) |
2180 "Find the subfolders of FOLDER. | 524 "Find the subfolders of FOLDER. |
2181 The function avoids running folders unnecessarily by caching the | 525 The function avoids running folders unnecessarily by caching the |
2182 results of the actual folders call. | 526 results of the actual folders call. |
2183 | 527 |
2242 (cons (substring (car f) folder-name-len) | 586 (cons (substring (car f) folder-name-len) |
2243 (cdr f))) | 587 (cdr f))) |
2244 results)))) | 588 results)))) |
2245 results)) | 589 results)) |
2246 | 590 |
591 ;;;###mh-autoload | |
2247 (defun mh-remove-from-sub-folders-cache (folder) | 592 (defun mh-remove-from-sub-folders-cache (folder) |
2248 "Remove FOLDER and its parent from `mh-sub-folders-cache'. | 593 "Remove FOLDER and its parent from `mh-sub-folders-cache'. |
2249 FOLDER should be unconditionally removed from the cache. Also the | 594 FOLDER should be unconditionally removed from the cache. Also the |
2250 last ancestor of FOLDER present in the cache must be removed as | 595 last ancestor of FOLDER present in the cache must be removed as |
2251 well. | 596 well. |
2267 (if one-ancestor-found | 612 (if one-ancestor-found |
2268 (return-from ancestor-found) | 613 (return-from ancestor-found) |
2269 (setq one-ancestor-found t)))) | 614 (setq one-ancestor-found t)))) |
2270 (remhash nil mh-sub-folders-cache)))) | 615 (remhash nil mh-sub-folders-cache)))) |
2271 | 616 |
617 | |
618 | |
619 ;;; Folder Utilities | |
620 | |
621 ;;;###mh-autoload | |
622 (defun mh-folder-name-p (name) | |
623 "Return non-nil if NAME is the name of a folder. | |
624 A name (a string or symbol) can be a folder name if it begins | |
625 with \"+\"." | |
626 (if (symbolp name) | |
627 (eq (aref (symbol-name name) 0) ?+) | |
628 (and (> (length name) 0) | |
629 (eq (aref name 0) ?+)))) | |
630 | |
631 ;;;###mh-autoload | |
632 (defun mh-expand-file-name (filename &optional default) | |
633 "Expand FILENAME like `expand-file-name', but also handle MH folder names. | |
634 Any filename that starts with '+' is treated as a folder name. | |
635 See `expand-file-name' for description of DEFAULT." | |
636 (if (mh-folder-name-p filename) | |
637 (expand-file-name (substring filename 1) mh-user-path) | |
638 (expand-file-name filename default))) | |
639 | |
2272 (defvar mh-folder-hist nil) | 640 (defvar mh-folder-hist nil) |
2273 | 641 |
2274 ;; Shush compiler. | 642 ;; Shush compiler. |
2275 (eval-when-compile | 643 (eval-when-compile (defvar mh-speed-flists-cache)) |
2276 (defvar mh-speed-folder-map) | |
2277 (defvar mh-speed-flists-cache)) | |
2278 | 644 |
2279 (defvar mh-allow-root-folder-flag nil | 645 (defvar mh-allow-root-folder-flag nil |
2280 "Non-nil means \"+\" is an acceptable folder name. | 646 "Non-nil means \"+\" is an acceptable folder name. |
2281 This variable is used to communicate with | 647 This variable is used to communicate with |
2282 `mh-folder-completion-function'. That function can have exactly | 648 `mh-folder-completion-function'. That function can have exactly |
2287 (defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map)) | 653 (defvar mh-folder-completion-map (copy-keymap minibuffer-local-completion-map)) |
2288 (define-key mh-folder-completion-map " " 'minibuffer-complete) ;Why??? | 654 (define-key mh-folder-completion-map " " 'minibuffer-complete) ;Why??? |
2289 | 655 |
2290 (defvar mh-speed-flists-inhibit-flag nil) | 656 (defvar mh-speed-flists-inhibit-flag nil) |
2291 | 657 |
658 ;;;###mh-autoload | |
2292 (defun mh-speed-flists-active-p () | 659 (defun mh-speed-flists-active-p () |
2293 "Check if speedbar is running with message counts enabled." | 660 "Check if speedbar is running with message counts enabled." |
2294 (and (featurep 'mh-speed) | 661 (and (featurep 'mh-speed) |
2295 (not mh-speed-flists-inhibit-flag) | 662 (not mh-speed-flists-inhibit-flag) |
2296 (> (hash-table-count mh-speed-flists-cache) 0))) | 663 (> (hash-table-count mh-speed-flists-cache) 0))) |
2297 | 664 |
665 ;;;###mh-autoload | |
2298 (defun mh-folder-completion-function (name predicate flag) | 666 (defun mh-folder-completion-function (name predicate flag) |
2299 "Programmable completion for folder names. | 667 "Programmable completion for folder names. |
2300 NAME is the partial folder name that has been input. PREDICATE if | 668 NAME is the partial folder name that has been input. PREDICATE if |
2301 non-nil is a function that is used to filter the possible choices | 669 non-nil is a function that is used to filter the possible choices |
2302 and FLAG determines whether the completion is over." | 670 and FLAG determines whether the completion is over." |
2330 (substring (mh-normalize-folder-name name) 1)))) | 698 (substring (mh-normalize-folder-name name) 1)))) |
2331 (cond (mh-allow-root-folder-flag (file-exists-p path)) | 699 (cond (mh-allow-root-folder-flag (file-exists-p path)) |
2332 ((equal path mh-user-path) nil) | 700 ((equal path mh-user-path) nil) |
2333 (t (file-exists-p path)))))))) | 701 (t (file-exists-p path)))))))) |
2334 | 702 |
703 ;; Shush compiler. | |
704 (eval-when-compile | |
705 (mh-do-in-xemacs | |
706 (defvar completion-root-regexp) | |
707 (defvar minibuffer-completing-file-name))) | |
708 | |
2335 (defun mh-folder-completing-read (prompt default allow-root-folder-flag) | 709 (defun mh-folder-completing-read (prompt default allow-root-folder-flag) |
2336 "Read folder name with PROMPT and default result DEFAULT. | 710 "Read folder name with PROMPT and default result DEFAULT. |
2337 If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be | 711 If ALLOW-ROOT-FOLDER-FLAG is non-nil then \"+\" is allowed to be |
2338 a folder name corresponding to `mh-user-path'." | 712 a folder name corresponding to `mh-user-path'." |
2339 (mh-normalize-folder-name | 713 (mh-normalize-folder-name |
2343 (mh-allow-root-folder-flag allow-root-folder-flag)) | 717 (mh-allow-root-folder-flag allow-root-folder-flag)) |
2344 (completing-read prompt 'mh-folder-completion-function nil nil nil | 718 (completing-read prompt 'mh-folder-completion-function nil nil nil |
2345 'mh-folder-hist default)) | 719 'mh-folder-hist default)) |
2346 t)) | 720 t)) |
2347 | 721 |
722 ;;;###mh-autoload | |
2348 (defun mh-prompt-for-folder (prompt default can-create | 723 (defun mh-prompt-for-folder (prompt default can-create |
2349 &optional default-string allow-root-folder-flag) | 724 &optional default-string allow-root-folder-flag) |
2350 "Prompt for a folder name with PROMPT. | 725 "Prompt for a folder name with PROMPT. |
2351 Returns the folder's name as a string. DEFAULT is used if the | 726 Returns the folder's name as a string. DEFAULT is used if the |
2352 folder exists and the user types return. If the CAN-CREATE flag | 727 folder exists and the user types return. If the CAN-CREATE flag |
2406 (mh-expand-file-name folder-name))))) | 781 (mh-expand-file-name folder-name))))) |
2407 folder-name)) | 782 folder-name)) |
2408 | 783 |
2409 | 784 |
2410 | 785 |
2411 ;;; List and string manipulation | 786 ;;; Message Utilities |
2412 | 787 |
2413 (defun mh-list-to-string (l) | 788 ;; Functions that would ordinarily be in mh-letter.el that are needed |
2414 "Flatten the list L and make every element of the new list into a string." | 789 ;; by mh-show.el are found here in order to prevent the loading of |
2415 (nreverse (mh-list-to-string-1 l))) | 790 ;; mh-letter.el until a message is actually composed. |
2416 | 791 |
2417 (defun mh-list-to-string-1 (l) | 792 ;;;###mh-autoload |
2418 "Flatten the list L and make every element of the new list into a string." | 793 (defun mh-in-header-p () |
2419 (let ((new-list nil)) | 794 "Return non-nil if the point is in the header of a draft message." |
2420 (while l | 795 (< (point) (mh-mail-header-end))) |
2421 (cond ((null (car l))) | 796 |
2422 ((symbolp (car l)) | 797 ;;;###mh-autoload |
2423 (setq new-list (cons (symbol-name (car l)) new-list))) | 798 (defun mh-extract-from-header-value () |
2424 ((numberp (car l)) | 799 "Extract From: string from header." |
2425 (setq new-list (cons (int-to-string (car l)) new-list))) | 800 (save-excursion |
2426 ((equal (car l) "")) | 801 (if (not (mh-goto-header-field "From:")) |
2427 ((stringp (car l)) (setq new-list (cons (car l) new-list))) | 802 nil |
2428 ((listp (car l)) | 803 (skip-chars-forward " \t") |
2429 (setq new-list (nconc (mh-list-to-string-1 (car l)) | 804 (buffer-substring-no-properties |
2430 new-list))) | 805 (point) (progn (mh-header-field-end)(point)))))) |
2431 (t (error "Bad element in `mh-list-to-string': %s" (car l)))) | 806 |
2432 (setq l (cdr l))) | 807 ;;;###mh-autoload |
2433 new-list)) | 808 (defun mh-goto-header-field (field) |
2434 | 809 "Move to FIELD in the message header. |
2435 (defun mh-replace-string (old new) | 810 Move to the end of the FIELD name, which should end in a colon. |
2436 "Replace all occurrences of OLD with NEW in the current buffer. | 811 Returns t if found, nil if not." |
2437 Ignores case when searching for OLD." | |
2438 (goto-char (point-min)) | 812 (goto-char (point-min)) |
2439 (let ((case-fold-search t)) | 813 (let ((case-fold-search t) |
2440 (while (search-forward old nil t) | 814 (headers-end (save-excursion |
2441 (replace-match new t t)))) | 815 (mh-goto-header-end 0) |
816 (point)))) | |
817 (re-search-forward (format "^%s" field) headers-end t))) | |
818 | |
819 ;;;###mh-autoload | |
820 (defun mh-goto-header-end (arg) | |
821 "Move the cursor ARG lines after the header." | |
822 (if (re-search-forward "^-*$" nil nil) | |
823 (forward-line arg))) | |
824 | |
825 ;;;###mh-autoload | |
826 (defun mh-mail-header-end () | |
827 "Substitute for `mail-header-end' that doesn't widen the buffer. | |
828 | |
829 In MH-E we frequently need to find the end of headers in nested | |
830 messages, where the buffer has been narrowed. This function works | |
831 in this situation." | |
832 (save-excursion | |
833 ;; XXX: The following replaces a call to rfc822-goto-eoh. Occasionally, | |
834 ;; mail headers that MH-E has to read contains lines of the form: | |
835 ;; From xxx@yyy Mon May 10 11:48:07 2004 | |
836 ;; In this situation, rfc822-goto-eoh doesn't go to the end of the | |
837 ;; header. The replacement allows From_ lines in the mail header. | |
838 (goto-char (point-min)) | |
839 (loop for p = (re-search-forward | |
840 "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move) | |
841 do (cond ((null p) (return)) | |
842 (t (goto-char (match-beginning 0)) | |
843 (unless (looking-at "From ") (return)) | |
844 (goto-char p)))) | |
845 (point))) | |
846 | |
847 ;;;###mh-autoload | |
848 (defun mh-header-field-beginning () | |
849 "Move to the beginning of the current header field. | |
850 Handles RFC 822 continuation lines." | |
851 (beginning-of-line) | |
852 (while (looking-at "^[ \t]") | |
853 (forward-line -1))) | |
854 | |
855 ;;;###mh-autoload | |
856 (defun mh-header-field-end () | |
857 "Move to the end of the current header field. | |
858 Handles RFC 822 continuation lines." | |
859 (forward-line 1) | |
860 (while (looking-at "^[ \t]") | |
861 (forward-line 1)) | |
862 (backward-char 1)) ;to end of previous line | |
863 | |
864 ;;;###mh-autoload | |
865 (defun mh-signature-separator-p () | |
866 "Return non-nil if buffer includes \"^-- $\"." | |
867 (save-excursion | |
868 (goto-char (point-min)) | |
869 (re-search-forward mh-signature-separator-regexp nil t))) | |
2442 | 870 |
2443 (provide 'mh-utils) | 871 (provide 'mh-utils) |
2444 | 872 |
2445 ;; Local Variables: | 873 ;; Local Variables: |
2446 ;; indent-tabs-mode: nil | 874 ;; indent-tabs-mode: nil |