Mercurial > emacs
comparison lisp/mh-e/mh-mime.el @ 68465:37d03b3298bf
The Great Cleanup
Remove circular dependencies.
mh-e.el now includes few require statements and stands alone. Other
files should need to require mh-e.el, which requires mh-loaddefs.el,
plus variable-only files such as mh-scan.el.
Remove unneeded require statements.
Remove unneeded load statements, or replace them with non-fatal
require statements.
Break out components into their own files that were often spread
between many files. As a result, many functions that are now only used
within a single file no longer need to be autoloaded.
Rearrange and provide consistent headings.
Untabify.
* mh-acros.el: Update commentary to reflect current usage. Add
autoload cookies to all macros.
(mh-require-cl): Merge docstring and comment.
(mh-do-in-xemacs): Fix typo in docstring.
(assoc-string): Move to new file mh-compat.el.
(with-mh-folder-updating, mh-in-show-buffer)
(mh-do-at-event-location, mh-seq-msgs): Move here from mh-utils.el.
(mh-iterate-on-messages-in-region, mh-iterate-on-range): Move here
from mh-seq.el.
* mh-alias.el (mh-address-mail-regexp)
(mh-goto-address-find-address-at-point): Move here from mh-utils.el.
(mh-folder-line-matches-show-buffer-p): Move here from mh-e.el.
* mh-buffers.el: Update descriptive text.
* mh-comp.el (mh-note-repl, mh-note-forw, mh-note-dist): Move to new
file mh-scan.el.
(mh-yank-hooks, mh-to-field-choices, mh-position-on-field)
(mh-letter-menu, mh-letter-mode-help-messages)
(mh-letter-buttons-init-flag, mh-letter-mode)
(mh-font-lock-field-data, mh-letter-header-end)
(mh-auto-fill-for-letter, mh-to-field, mh-to-fcc)
(mh-file-is-vcard-p, mh-insert-signature, mh-check-whom)
(mh-insert-letter, mh-extract-from-attribution, mh-yank-cur-msg)
(mh-filter-out-non-text, mh-insert-prefix-string)
(mh-current-fill-prefix, mh-open-line, mh-complete-word)
(mh-folder-expand-at-point, mh-letter-complete-function-alist)
(mh-letter-complete, mh-letter-complete-or-space)
(mh-letter-confirm-address, mh-letter-header-field-at-point)
(mh-letter-next-header-field-or-indent)
(mh-letter-next-header-field, mh-letter-previous-header-field)
(mh-letter-skipped-header-field-p)
(mh-letter-skip-leading-whitespace-in-header-field)
(mh-hidden-header-keymap)
(mh-letter-toggle-header-field-display-button)
(mh-letter-toggle-header-field-display)
(mh-letter-truncate-header-field, mh-letter-mode-map): Move to new
file mh-letter.el.
(mh-letter-mode-map, mh-sent-from-folder, mh-send-args)
(mh-pgp-support-flag, mh-x-mailer-string)
(mh-letter-header-field-regexp): Move to mh-e.el.
(mh-goto-header-field, mh-goto-header-end)
(mh-extract-from-header-value, mh-beginning-of-word): Move to
mh-utils.el.
(mh-insert-header-separator): Move to mh-comp.el.
(mh-display-completion-list-compat): Move to new file mh-compat.el.
* mh-compat.el: New file.
(assoc-string): Move here from mh-acros.el.
(mh-display-completion-list): Move here from mh-comp.el.
* mh-customize.el: Move content into mh-e.el and remove.
* mh-e.el (mh-folder-mode-map, mh-folder-seq-tool-bar-map)
(mh-folder-tool-bar-map, mh-inc-spool-map, mh-letter-mode-map)
(mh-letter-tool-bar-map, mh-search-mode-map, mh-show-mode-map)
(mh-show-seq-tool-bar-map, mh-show-tool-bar-map): All maps now
declared here so that they can be used in docstrings.
(mh-sent-from-folder, mh-sent-from-msg)
(mh-letter-header-field-regexp, mh-pgp-support-flag)
(mh-x-mailer-string): Move here from mh-comp.el.
(mh-folder-line-matches-show-buffer-p): Move to mh-alias.el.
(mh-thread-scan-line-map, mh-thread-scan-line-map-stack): Move here
from mh-seq.el.
(mh-draft-folder, mh-inbox, mh-user-path, mh-current-folder)
(mh-previous-window-config, mh-seen-list, mh-seq-list)
(mh-show-buffer, mh-showing-mode, mh-globals-hash)
(mh-show-folder-buffer, mh-mail-header-separator)
(mh-unseen-seq, mh-previous-seq, mh-page-to-next-msg-flag)
(mh-signature-separator, mh-signature-separator-regexp)
(mh-list-to-string, mh-list-to-string-1): Move here from mh-utils.el.
(mh-index-max-cmdline-args, mh-xargs, mh-quote-for-shell)
(mh-exec-cmd, mh-exec-cmd-error, mh-exec-cmd-daemon)
(mh-exec-cmd-env-daemon, mh-process-daemon, mh-exec-cmd-quiet)
(mh-exec-cmd-output)
(mh-exchange-point-and-mark-preserving-active-mark)
(mh-exec-lib-cmd-output, mh-handle-process-error): Move here from
deprecated file mh-exec.el.
(mh-path): Move here from deprecated file mh-customize.el.
(mh-sys-path, mh-variants, mh-variant-in-use, mh-progs, mh-lib)
(mh-flists-present-flag, mh-variants, mh-variant-mh-info)
(mh-variant-mu-mh-info, mh-variant-nmh-info, mh-file-command-p)
(mh-variant-set-variant, mh-variant-p, mh-profile-component)
(mh-profile-component-value, mh-defface-compat): Move here from
deprecated file mh-init.el.
(mh-goto-next-button, mh-folder-mime-action)
(mh-folder-toggle-mime-part, mh-folder-inline-mime-part)
(mh-folder-save-mime-part, mh-toggle-mime-buttons): Move to to
mh-mime.el.
(mh-scan-format-mh, mh-scan-format-nmh, mh-note-deleted)
(mh-note-refiled, mh-note-cur, mh-scan-good-msg-regexp)
(mh-scan-deleted-msg-regexp, mh-scan-refiled-msg-regexp)
(mh-scan-valid-regexp, mh-scan-cur-msg-number-regexp)
(mh-scan-date-regexp, mh-scan-rcpt-regexp, mh-scan-body-regexp)
(mh-scan-subject-regexp, mh-scan-sent-to-me-sender-regexp)
(mh-scan-cmd-note-width, mh-scan-destination-width)
(mh-scan-date-width, mh-scan-date-flag-width)
(mh-scan-from-mbox-width, mh-scan-from-mbox-sep-width)
(mh-scan-field-destination-offset)
(mh-scan-field-from-start-offset, mh-scan-field-from-end-offset)
(mh-scan-field-subject-start-offset, mh-scan-format)
(mh-msg-num-width-to-column, mh-set-cmd-note): Move to new file
mh-scan.el.
(mh-partial-folder-mode-line-annotation)
(mh-folder-font-lock-keywords, mh-folder-font-lock-subject)
(mh-generate-sequence-font-lock, mh-last-destination)
(mh-last-destination-write, mh-first-msg-num, mh-last-msg-num)
(mh-rmail, mh-nmail, mh-delete-msg, mh-delete-msg-no-motion)
(mh-execute-commands, mh-first-msg, mh-header-display)
(mh-inc-folder, mh-last-msg, mh-next-undeleted-msg)
(mh-folder-from-address, mh-prompt-for-refile-folder)
(mh-refile-msg, mh-refile-or-write-again, mh-quit, mh-page-msg)
(mh-previous-page, mh-previous-undeleted-msg)
(mh-previous-unread-msg, mh-next-button, mh-prev-button)
(mh-reset-threads-and-narrowing, mh-rescan-folder)
(mh-write-msg-to-file, mh-toggle-showing, mh-undo)
(mh-visit-folder, mh-update-sequences, mh-delete-a-msg)
(mh-refile-a-msg, mh-next-msg, mh-next-unread-msg)
(mh-set-scan-mode, mh-undo-msg, mh-make-folder)
(mh-folder-sequence-menu, mh-folder-message-menu)
(mh-folder-folder-menu, mh-remove-xemacs-horizontal-scrollbar)
(mh-write-file-functions-compat, mh-folder-mode)
(mh-restore-desktop-buffer, mh-scan-folder)
(mh-regenerate-headers, mh-generate-new-cmd-note)
(mh-get-new-mail, mh-make-folder-mode-line, mh-goto-cur-msg)
(mh-process-or-undo-commands, mh-process-commands)
(mh-update-unseen, mh-delete-scan-msgs)
(mh-outstanding-commands-p): Move to new file mh-folder.el.
(mh-mapc, mh-colors-available-p, mh-colors-in-use-p)
(mh-make-local-vars, mh-coalesce-msg-list, mh-greaterp)
(mh-lessp): Move to mh-utils.el.
(mh-parse-flist-output-line, mh-folder-size-folder)
(mh-folder-size-flist, mh-folder-size, mh-add-sequence-notation)
(mh-remove-sequence-notation, mh-remove-cur-notation)
(mh-remove-all-notation, mh-delete-seq-locally)
(mh-read-folder-sequences, mh-read-msg-list)
(mh-notate-user-sequences, mh-internal-seqs, mh-internal-seq)
(mh-valid-seq-p, mh-delete-msg-from-seq, mh-catchup)
(mh-delete-a-msg-from-seq, mh-undefine-sequence)
(mh-define-sequence, mh-seq-containing-msg): Move to mh-seq.el.
(mh-xemacs-flag)
(mh-customize, mh-e, mh-alias, mh-folder, mh-folder-selection)
(mh-identity, mh-inc, mh-junk, mh-letter, mh-ranges)
(mh-scan-line-formats, mh-search, mh-sending-mail, mh-sequences)
(mh-show, mh-speedbar, mh-thread, mh-tool-bar, mh-hooks)
(mh-faces, mh-alias-completion-ignore-case-flag)
(mh-alias-expand-aliases-flag, mh-alias-flash-on-comma)
(mh-alias-insert-file, mh-alias-insertion-location)
(mh-alias-local-users, mh-alias-local-users-prefix)
(mh-alias-passwd-gecos-comma-separator-flag)
(mh-new-messages-folders, mh-ticked-messages-folders)
(mh-large-folder, mh-recenter-summary-flag)
(mh-recursive-folders-flag, mh-sortm-args)
(mh-default-folder-for-message-function, mh-default-folder-list)
(mh-default-folder-must-exist-flag, mh-default-folder-prefix)
(mh-identity-list, mh-auto-fields-list)
(mh-auto-fields-prompt-flag, mh-identity-default)
(mh-identity-handlers, mh-inc-prog, mh-inc-spool-list)
(mh-junk-choice, mh-junk-function-alist, mh-junk-choose)
(mh-junk-background, mh-junk-disposition, mh-junk-program)
(mh-compose-insertion, mh-compose-skipped-header-fields)
(mh-compose-space-does-completion-flag)
(mh-delete-yanked-msg-window-flag)
(mh-extract-from-attribution-verb, mh-ins-buf-prefix)
(mh-letter-complete-function, mh-letter-fill-column)
(mh-mml-method-default, mh-signature-file-name)
(mh-signature-separator-flag, mh-x-face-file, mh-yank-behavior)
(mh-interpret-number-as-range-flag, mh-adaptive-cmd-note-flag)
(mh-scan-format-file-check, mh-scan-format-file)
(mh-adaptive-cmd-note-flag-check, mh-scan-prog)
(mh-search-program, mh-compose-forward-as-mime-flag)
(mh-compose-letter-function, mh-compose-prompt-flag)
(mh-forward-subject-format, mh-insert-x-mailer-flag)
(mh-redist-full-contents-flag, mh-reply-default-reply-to)
(mh-reply-show-message-flag, mh-refile-preserves-sequences-flag)
(mh-tick-seq, mh-update-sequences-after-mh-show-flag)
(mh-bury-show-buffer-flag, mh-clean-message-header-flag)
(mh-decode-mime-flag, mh-display-buttons-for-alternatives-flag)
(mh-display-buttons-for-inline-parts-flag)
(mh-do-not-confirm-flag, mh-fetch-x-image-url)
(mh-graphical-smileys-flag, mh-graphical-emphasis-flag)
(mh-highlight-citation-style)
(mh-invisible-header-fields-internal)
(mh-delay-invisible-header-generation-flag)
(mh-invisible-header-fields, mh-invisible-header-fields-default)
(mh-invisible-header-fields-compiled, mh-invisible-headers)
(mh-lpr-command-format, mh-max-inline-image-height)
(mh-max-inline-image-width, mh-mhl-format-file)
(mh-mime-save-parts-default-directory, mh-print-background-flag)
(mh-show-maximum-size, mh-show-use-goto-addr-flag)
(mh-show-use-xface-flag, mh-store-default-directory)
(mh-summary-height, mh-speed-update-interval)
(mh-show-threads-flag, mh-tool-bar-search-function)
(mh-after-commands-processed-hook, mh-alias-reloaded-hook)
(mh-before-commands-processed-hook, mh-before-quit-hook)
(mh-before-send-letter-hook, mh-delete-msg-hook)
(mh-find-path-hook, mh-folder-mode-hook, mh-forward-hook)
(mh-inc-folder-hook, mh-insert-signature-hook)
(mh-kill-folder-suppress-prompt-hooks, mh-letter-mode-hook)
(mh-mh-to-mime-hook, mh-search-mode-hook, mh-quit-hook)
(mh-refile-msg-hook, mh-show-hook, mh-show-mode-hook)
(mh-unseen-updated-hook, mh-min-colors-defined-flag)
(mh-folder-address, mh-folder-body)
(mh-folder-cur-msg-number, mh-folder-date, mh-folder-deleted)
(mh-folder-followup, mh-folder-msg-number, mh-folder-refiled)
(mh-folder-sent-to-me-hint, mh-folder-sent-to-me-sender)
(mh-folder-subject, mh-folder-tick, mh-folder-to)
(mh-search-folder, mh-letter-header-field, mh-show-cc)
(mh-show-date, mh-show-from, mh-show-header, mh-show-pgg-bad)
(mh-show-pgg-good, mh-show-pgg-unknown, mh-show-signature)
(mh-show-subject, mh-show-to, mh-show-xface, mh-speedbar-folder)
(mh-speedbar-folder-with-unseen-messages)
(mh-speedbar-selected-folder)
(mh-speedbar-selected-folder-with-unseen-messages): Move here from
deprecated file mh-customize.el.
* mh-exec.el: Move content into mh-e.el and remove.
* mh-folder.el: New file. Contains mh-folder-mode from mh-e.el
* mh-funcs.el (mh-note-copied, mh-note-printed): Move to new file
mh-scan.el.
(mh-ephem-message, mh-help, mh-prefix-help): Move to mh-utils.el.
* mh-gnus.el (mm-uu-dissect-text-parts): Add.
(mh-mail-abbrev-make-syntax-table): Move to mh-utils.el and rename to
mail-abbrev-make-syntax-table.
* mh-identity.el (mh-identity-menu): New variable for existing menu.
(mh-identity-make-menu-no-autoload): New alias for
mh-identity-make-menu which can be called from mh-e.el.
(mh-identity-list-set): Move to mh-e.el.
(mh-identity-add-menu): New function
(mh-insert-identity): Add optional argument maybe-insert so that local
variable mh-identity-local does not have to be visible.
(mh-identity-handler-default):
* mh-inc.el (mh-inc-spool-map): Move declaration to mh-e.el (with rest
of keymaps). Update key binding for ? to call mh-help with help
messages in new argument.
(mh-inc-spool-make-no-autoload): New alias for mh-inc-spool-make which
can be called from mh-e.el.
(mh-inc-spool-list-set): Simplify update of mh-inc-spool-map-help.
* mh-init.el: Move content into mh-e.el and remove.
* mh-junk.el: Update requires, untabify, and add mh-autoload cookies.
* mh-letter.el: New file. Contains mh-letter-mode from mh-comp.el.
* mh-limit.el: New file. Contains display limit commands from
mh-mime.el.
* mh-mime.el: Rearrange for consistency with other files.
(mh-buffer-data, mh-mm-inline-media-tests): Move here from
mh-utils.el.
(mh-folder-inline-mime-part, mh-folder-save-mime-part)
(mh-folder-toggle-mime-part, mh-toggle-mime-buttons)
(mh-goto-next-button): Move here from mh-e.el.
* mh-print.el: Rearrange for consistency with other files.
* mh-scan.el: New file. Contains scan line constants and utilities
from XXX, mh-funcs, mh-utils.el.
* mh-search.el: Rearrange for consistency with other files.
(mh-search-mode-map): Drop C-c C-f {dr} bindings since these fields
which don't exist in the saved header. Replace C-c C-f f with C-c C-f
m per mail-mode consistency.
(mh-search-mode): Use mh-set-help instead of setting mh-help-messages.
* mh-seq.el (mh-thread-message, mh-thread-container)
(mh-thread-id-hash, mh-thread-subject-hash, mh-thread-id-table)
(mh-thread-id-index-map, mh-thread-index-id-map)
(mh-thread-scan-line-map, mh-thread-scan-line-map-stack)
(mh-thread-subject-container-hash, mh-thread-duplicates)
(mh-thread-history, mh-thread-body-width)
(mh-thread-find-msg-subject mh-thread-initialize-hash)
(mh-thread-initialize, mh-thread-id-container)
(mh-thread-remove-parent-link, mh-thread-add-link)
(mh-thread-ancestor-p, mh-thread-get-message-container)
(mh-thread-get-message, mh-thread-canonicalize-id)
(mh-thread-prune-subject, mh-thread-container-subject)
(mh-thread-rewind-pruning, mh-thread-prune-containers)
(mh-thread-sort-containers, mh-thread-group-by-subject)
(mh-thread-process-in-reply-to, mh-thread-set-tables)
(mh-thread-update-id-index-maps, mh-thread-generate)
(mh-thread-inc, mh-thread-generate-scan-lines)
(mh-thread-parse-scan-line, mh-thread-update-scan-line-map)
(mh-thread-add-spaces, mh-thread-print-scan-lines)
(mh-thread-folder, mh-toggle-threads, mh-thread-forget-message)
(mh-thread-current-indentation-level, mh-thread-next-sibling)
(mh-thread-previous-sibling, mh-thread-immediate-ancestor)
(mh-thread-ancestor, mh-thread-find-children)
(mh-message-id-regexp, mh-thread-delete, mh-thread-refile): Move to
new file mh-thread.el.
(mh-subject-to-sequence, mh-subject-to-sequence-unthreaded)
(mh-subject-to-sequence-threaded, mh-edit-pick-expr)
(mh-pick-args-list, mh-narrow-to-subject, mh-narrow-to-from)
(mh-narrow-to-cc, mh-narrow-to-to, mh-narrow-to-header-field)
(mh-current-message-header-field, mh-narrow-to-range)
(mh-delete-subject, mh-delete-subject-or-thread): Move to new file
mh-limit.el.
(mh-iterate-on-messages-in-region, mh-iterate-on-range): Move to
mh-acros.el.
(mh-internal-seqs, mh-catchup, mh-delete-msg-from-seq)
(mh-internal-seq, mh-valid-seq-p, mh-seq-containing-msg)
(mh-define-sequence, mh-undefine-sequence)
(mh-delete-a-msg-from-seq, mh-delete-seq-locally)
(mh-folder-size, mh-folder-size-flist, mh-folder-size-folder)
(mh-parse-flist-output-line, mh-read-folder-sequences)
(mh-read-msg-list, mh-notate-user-sequences)
(mh-remove-cur-notation, mh-add-sequence-notation)
(mh-remove-sequence-notation, mh-remove-all-notation): Move here from
mh-e.el.
(mh-make-seq, mh-seq-name, mh-find-seq, mh-seq-to-msgs)
(mh-add-msgs-to-seq, mh-notate): Move here from mh-utils.el.
* mh-show.el: New file. Contains mh-show-mode from mh-utils.el.
* mh-speed.el: Rearrange for consistency with other files.
* mh-thread.el: New file. Contains threading code from mh-seq.el.
* mh-tool-bar.el: New file. Contains tool bar creation code from
deprecated file mh-customize.el.
* mh-utils.el (recursive-load-depth-limit): Remove setting. No longer
needed.
(mh-scan-msg-number-regexp, mh-scan-msg-overflow-regexp)
(mh-scan-msg-format-regexp, mh-scan-msg-format-string)
(mh-scan-msg-search-regexp, mh-cmd-note, mh-note-seq)
(mh-update-scan-format, mh-msg-num-width): Move to new file
mh-scan.el.
(mh-show-buffer-mode-line-buffer-id, mh-letter-header-font-lock)
(mh-header-field-font-lock, mh-header-to-font-lock)
(mh-header-cc-font-lock, mh-header-subject-font-lock)
(mh-show-font-lock-keywords)
(mh-show-font-lock-keywords-with-cite)
(mh-show-font-lock-fontify-region)
(mh-gnus-article-highlight-citation, mh-showing-with-headers)
(mh-start-of-uncleaned-message, mh-invalidate-show-buffer)
(mh-unvisit-file, mh-defun-show-buffer, mh-show-mode-map)
(mh-show-sequence-menu, mh-show-message-menu)
(mh-show-folder-menu, mh-show-mode, mh-show-addr)
(mh-maybe-show, mh-show, mh-show-msg, mh-show-unquote-From)
(mh-msg-folder, mh-display-msg, mh-clean-msg-header): Move to new file
mh-show.el.
(mh-mail-header-separator, mh-signature-separator-regexp)
(mh-signature-separator, mh-globals-hash, mh-user-path)
(mh-draft-folder, mh-unseen-seq, mh-previous-seq, mh-inbox)
(mh-previous-window-config, mh-current-folder mh-show-buffer)
(mh-showing-mode, mh-show-mode-map, mh-show-folder-buffer)
(mh-showing-mode, mh-seq-list, mh-seen-list, mh-summary-height)
(mh-list-to-string, mh-list-to-string-1): Move to mh-e.el.
(mh-buffer-data, mh-mm-inline-media-tests): Move to mh-mime.el.
(mh-address-mail-regexp, mh-goto-address-find-address-at-point): Move
to mh-alias.el.
(mh-letter-font-lock-keywords): Move to new file mh-letter.el.
(mh-folder-filename, mh-msg-count, mh-recenter, mh-msg-filename)
(mh-show-mouse, mh-modify, mh-goto-msg, mh-set-folder-modified-p):
Move to new file mh-folder.el.
(with-mh-folder-updating, mh-in-show-buffer)
(mh-do-at-event-location, mh-seq-msgs): Moved to mh-acros.el.
(mh-make-seq, mh-seq-name, mh-notate, mh-find-seq)
(mh-seq-to-msgs, mh-add-msgs-to-seq, mh-canonicalize-sequence): Moved
to mh-seq.el.
(mh-show-xface-function, mh-uncompface-executable, mh-face-to-png)
(mh-uncompface, mh-icontopbm, mh-face-foreground-compat)
(mh-face-background-compat, mh-face-display-function)
(mh-show-xface, mh-picon-directory-list)
(mh-picon-existing-directory-list)
(mh-picon-cache, mh-picon-image-types)
(mh-picon-set-directory-list, mh-picon-get-image)
(mh-picon-file-contents, mh-picon-generate-path)
(mh-x-image-cache-directory, mh-x-image-scaling-function)
(mh-wget-executable, mh-wget-choice, mh-wget-option)
(mh-x-image-temp-file, mh-x-image-url, mh-x-image-marker)
(mh-x-image-url-cache-file, mh-x-image-scale-with-pnm)
(mh-x-image-scale-with-convert)
(url-unreserved-chars, url-hexify-string)
(mh-x-image-url-cache-canonicalize)
(mh-x-image-set-download-state, mh-x-image-get-download-state)
(mh-x-image-url-fetch-image, mh-x-image-display)
(mh-x-image-scale-and-display, mh-x-image-url-sane-p)
(mh-x-image-url-display): Move to new file mh-xface.el.
(mh-logo-display): Call mh-image-load-path.
(mh-find-path-run, mh-find-path): Move here from deprecated file
mh-init.el.
(mh-help-messages): Now an alist of modes to an alist of messages.
(mh-set-help): New function used to set mh-help-messages
(mh-help): Adjust for new format of mh-help-messages. Add
help-messages argument.
(mh-prefix-help): Refactor to use mh-help.
(mh-coalesce-msg-list, mh-greaterp, mh-lessp): Move here from mh-e.el.
(mh-clear-sub-folders-cache): New function added to avoid exposing
mh-sub-folders-cache variable.
* mh-xface.el: New file. Contains X-Face and Face header field display
routines from mh-utils.el.
author | Bill Wohler <wohler@newt.com> |
---|---|
date | Sun, 29 Jan 2006 19:34:57 +0000 |
parents | 0c77c0b9a620 |
children | 6a7173abcf59 |
comparison
equal
deleted
inserted
replaced
68464:79464a6167f5 | 68465:37d03b3298bf |
---|---|
1 ;;; mh-mime.el --- MH-E support for composing MIME messages | 1 ;;; mh-mime.el --- MH-E MIME support |
2 | 2 |
3 ;; Copyright (C) 1993, 1995, | 3 ;; Copyright (C) 1993, 1995, |
4 ;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. | 4 ;; 2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc. |
5 | 5 |
6 ;; Author: Bill Wohler <wohler@newt.com> | 6 ;; Author: Bill Wohler <wohler@newt.com> |
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | 25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
26 ;; Boston, MA 02110-1301, USA. | 26 ;; Boston, MA 02110-1301, USA. |
27 | 27 |
28 ;;; Commentary: | 28 ;;; Commentary: |
29 | 29 |
30 ;; Internal support for MH-E package. | 30 ;; Message composition of MIME message is done with either MH-style |
31 ;; Support for generating MH-style directives for mhn or mhbuild as well as | 31 ;; directives for mhn or mhbuild (MH 6.8 or later) or MML (MIME Meta |
32 ;; MML (MIME Meta Language) tags. MH-style directives are supported by MH 6.8 | 32 ;; Language) tags. |
33 ;; or later. | 33 |
34 ;; TODO: | |
35 ;; Paragraph code should not fill # lines if MIME enabled. | |
36 ;; Implement mh-auto-mh-to-mime (if non-nil, \\[mh-send-letter] | |
37 ;; invokes mh-mh-to-mime automatically before sending.) | |
38 ;; Actually, instead of mh-auto-mh-to-mime, | |
39 ;; should read automhnproc from profile. | |
40 ;; MIME option to mh-forward command to move to content-description | |
41 ;; insertion point. | |
34 | 42 |
35 ;;; Change Log: | 43 ;;; Change Log: |
36 | 44 |
37 ;;; Code: | 45 ;;; Code: |
38 | 46 |
39 ;;(message "> mh-mime") | 47 (require 'mh-e) |
40 (eval-when-compile (require 'mh-acros)) | 48 (require 'mh-gnus) ;needed because mh-gnus.el not compiled |
41 (mh-require-cl) | 49 |
42 | 50 (require 'font-lock) |
43 (require 'gnus-util) | 51 (require 'gnus-util) |
44 (require 'mh-buffers) | 52 (require 'mailcap) |
45 (require 'mh-comp) | 53 (require 'mm-decode) |
46 (require 'mh-gnus) | 54 (require 'mm-view) |
47 ;;(message "< mh-mime") | 55 (require 'mml) |
48 | 56 |
49 (autoload 'article-emphasize "gnus-art") | 57 (autoload 'article-emphasize "gnus-art") |
50 (autoload 'gnus-article-goto-header "gnus-art") | |
51 (autoload 'gnus-eval-format "gnus-spec") | 58 (autoload 'gnus-eval-format "gnus-spec") |
52 (autoload 'gnus-get-buffer-create "gnus") | 59 (autoload 'mail-content-type-get "mail-parse") |
60 (autoload 'mail-decode-encoded-word-string "mail-parse") | |
61 (autoload 'mail-header-parse-content-type "mail-parse") | |
62 (autoload 'mail-header-strip "mail-parse") | |
53 (autoload 'message-options-set-recipient "message") | 63 (autoload 'message-options-set-recipient "message") |
64 (autoload 'mm-decode-body "mm-bodies") | |
54 (autoload 'mm-uu-dissect "mm-uu") | 65 (autoload 'mm-uu-dissect "mm-uu") |
55 (autoload 'mml-unsecure-message "mml-sec") | 66 (autoload 'mml-unsecure-message "mml-sec") |
56 (autoload 'rfc2047-decode-region "rfc2047") | 67 (autoload 'rfc2047-decode-region "rfc2047") |
57 (autoload 'widget-convert-button "wid-edit") | 68 (autoload 'widget-convert-button "wid-edit") |
58 | 69 |
59 ;;;###mh-autoload | |
60 (defun mh-compose-insertion (&optional inline) | |
61 "Add tag to include a file such as an image or sound. | |
62 | |
63 You are prompted for the filename containing the object, the | |
64 media type if it cannot be determined automatically, and a | |
65 content description. If you're using MH-style directives, you | |
66 will also be prompted for additional attributes. | |
67 | |
68 The option `mh-compose-insertion' controls what type of tags are | |
69 inserted. Optional argument INLINE means make it an inline | |
70 attachment." | |
71 (interactive "P") | |
72 (if (equal mh-compose-insertion 'mml) | |
73 (if inline | |
74 (mh-mml-attach-file "inline") | |
75 (mh-mml-attach-file)) | |
76 (call-interactively 'mh-mh-attach-file))) | |
77 | |
78 ;;;###mh-autoload | |
79 (defun mh-compose-forward (&optional description folder range) | |
80 "Add tag to forward a message. | |
81 | |
82 You are prompted for a content DESCRIPTION, the name of the | |
83 FOLDER in which the messages to forward are located, and a RANGE | |
84 of messages, which defaults to the current message in that | |
85 folder. Check the documentation of `mh-interactive-range' to see | |
86 how RANGE is read in interactive use. | |
87 | |
88 The option `mh-compose-insertion' controls what type of tags are inserted." | |
89 (interactive | |
90 (let* ((description | |
91 (mml-minibuffer-read-description)) | |
92 (folder | |
93 (mh-prompt-for-folder "Message from" | |
94 mh-sent-from-folder nil)) | |
95 (default | |
96 (if (and (equal folder mh-sent-from-folder) | |
97 (numberp mh-sent-from-msg)) | |
98 mh-sent-from-msg | |
99 (nth 0 (mh-translate-range folder "cur")))) | |
100 (range | |
101 (mh-read-range "Forward" folder | |
102 (or (and default | |
103 (number-to-string default)) | |
104 t) | |
105 t t))) | |
106 (list description folder range))) | |
107 (let ((messages (mapconcat 'identity (mh-list-to-string range) " "))) | |
108 (dolist (message (mh-translate-range folder messages)) | |
109 (if (equal mh-compose-insertion 'mml) | |
110 (mh-mml-forward-message description folder (format "%s" message)) | |
111 (mh-mh-forward-message description folder (format "%s" message)))))) | |
112 | |
113 ;; To do: | |
114 ;; paragraph code should not fill # lines if MIME enabled. | |
115 ;; implement mh-auto-mh-to-mime (if non-nil, \\[mh-send-letter] | |
116 ;; invokes mh-mh-to-mime automatically before sending.) | |
117 ;; actually, instead of mh-auto-mh-to-mime, | |
118 ;; should read automhnproc from profile | |
119 ;; MIME option to mh-forward | |
120 ;; command to move to content-description insertion point | |
121 | |
122 (defvar mh-mh-to-mime-args nil | |
123 "Extra arguments for \\[mh-mh-to-mime] to pass to the \"mhbuild\" command. | |
124 The arguments are passed to \"mhbuild\" if \\[mh-mh-to-mime] is | |
125 given a prefix argument. Normally default arguments to | |
126 \"mhbuild\" are specified in the MH profile.") | |
127 | |
128 (defvar mh-media-type-regexp | |
129 (concat (regexp-opt '("text" "image" "audio" "video" "application" | |
130 "multipart" "message") t) | |
131 "/[-.+a-zA-Z0-9]+") | |
132 "Regexp matching valid media types used in MIME attachment compositions.") | |
133 | |
134 (defvar mh-have-file-command 'undefined | |
135 "Cached value of function `mh-have-file-command'. | |
136 Do not reference this variable directly as it might not have been | |
137 initialized. Always use the command `mh-have-file-command'.") | |
138 | |
139 ;;;###mh-autoload | |
140 (defun mh-have-file-command () | |
141 "Return t if 'file' command is on the system. | |
142 'file -i' is used to get MIME type of composition insertion." | |
143 (when (eq mh-have-file-command 'undefined) | |
144 (setq mh-have-file-command | |
145 (and (fboundp 'executable-find) | |
146 (executable-find "file") ; file command exists | |
147 ; and accepts -i and -b args. | |
148 (zerop (call-process "file" nil nil nil "-i" "-b" | |
149 (expand-file-name "inc" mh-progs)))))) | |
150 mh-have-file-command) | |
151 | |
152 (defvar mh-file-mime-type-substitutions | |
153 '(("application/msword" "\.xls" "application/ms-excel") | |
154 ("application/msword" "\.ppt" "application/ms-powerpoint") | |
155 ("text/plain" "\.vcf" "text/x-vcard")) | |
156 "Substitutions to make for Content-Type returned from file command. | |
157 The first element is the Content-Type returned by the file command. | |
158 The second element is a regexp matching the file name, usually the | |
159 extension. | |
160 The third element is the Content-Type to replace with.") | |
161 | |
162 (defun mh-file-mime-type-substitute (content-type filename) | |
163 "Return possibly changed CONTENT-TYPE on the FILENAME. | |
164 Substitutions are made from the `mh-file-mime-type-substitutions' | |
165 variable." | |
166 (let ((subst mh-file-mime-type-substitutions) | |
167 (type) (match) (answer content-type) | |
168 (case-fold-search t)) | |
169 (while subst | |
170 (setq type (car (car subst)) | |
171 match (elt (car subst) 1)) | |
172 (if (and (string-equal content-type type) | |
173 (string-match match filename)) | |
174 (setq answer (elt (car subst) 2) | |
175 subst nil) | |
176 (setq subst (cdr subst)))) | |
177 answer)) | |
178 | |
179 ;;;###mh-autoload | |
180 (defun mh-file-mime-type (filename) | |
181 "Return MIME type of FILENAME from file command. | |
182 Returns nil if file command not on system." | |
183 (cond | |
184 ((not (mh-have-file-command)) | |
185 nil) ;no file command, exit now | |
186 ((not (and (file-exists-p filename) | |
187 (file-readable-p filename))) | |
188 nil) ;no file or not readable, ditto | |
189 (t | |
190 (save-excursion | |
191 (let ((tmp-buffer (get-buffer-create mh-temp-buffer))) | |
192 (set-buffer tmp-buffer) | |
193 (unwind-protect | |
194 (progn | |
195 (call-process "file" nil '(t nil) nil "-b" "-i" | |
196 (expand-file-name filename)) | |
197 (goto-char (point-min)) | |
198 (if (not (re-search-forward mh-media-type-regexp nil t)) | |
199 nil | |
200 (mh-file-mime-type-substitute (match-string 0) filename))) | |
201 (kill-buffer tmp-buffer))))))) | |
202 | |
203 (defun mh-minibuffer-read-type (filename &optional default) | |
204 "Return the content type associated with the given FILENAME. | |
205 If the \"file\" command exists and recognizes the given file, | |
206 then its value is returned\; otherwise, the user is prompted for | |
207 a type (see `mailcap-mime-types' and for Emacs 20, | |
208 `mh-mime-content-types'). | |
209 Optional argument DEFAULT is returned if a type isn't entered." | |
210 (mailcap-parse-mimetypes) | |
211 (let* ((default (or default | |
212 (mm-default-file-encoding filename) | |
213 "application/octet-stream")) | |
214 (probed-type (mh-file-mime-type filename)) | |
215 (type (or (and (not (equal probed-type "application/octet-stream")) | |
216 probed-type) | |
217 (completing-read | |
218 (format "Content type (default %s): " default) | |
219 (mapcar 'list (mailcap-mime-types)))))) | |
220 (if (not (equal type "")) | |
221 type | |
222 default))) | |
223 | |
224 ;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One: | |
225 ;; Format of Internet Message Bodies. | |
226 ;; RFC 2046 - Multipurpose Internet Mail Extensions (MIME) Part Two: | |
227 ;; Media Types. | |
228 ;; RFC 2049 - Multipurpose Internet Mail Extensions (MIME) Part Five: | |
229 ;; Conformance Criteria and Examples. | |
230 ;; RFC 2017 - Definition of the URL MIME External-Body Access-Type | |
231 ;; RFC 1738 - Uniform Resource Locators (URL) | |
232 (defvar mh-access-types | |
233 '(("anon-ftp") ; RFC2046 Anonymous File Transfer Protocol | |
234 ("file") ; RFC1738 Host-specific file names | |
235 ("ftp") ; RFC2046 File Transfer Protocol | |
236 ("gopher") ; RFC1738 The Gopher Protocol | |
237 ("http") ; RFC1738 Hypertext Transfer Protocol | |
238 ("local-file") ; RFC2046 Local file access | |
239 ("mail-server") ; RFC2046 mail-server Electronic mail address | |
240 ("mailto") ; RFC1738 Electronic mail address | |
241 ("news") ; RFC1738 Usenet news | |
242 ("nntp") ; RFC1738 Usenet news using NNTP access | |
243 ("propspero") ; RFC1738 Prospero Directory Service | |
244 ("telnet") ; RFC1738 Telnet | |
245 ("tftp") ; RFC2046 Trivial File Transfer Protocol | |
246 ("url") ; RFC2017 URL scheme MIME access-type Protocol | |
247 ("wais")) ; RFC1738 Wide Area Information Servers | |
248 "Valid MIME access-type values.") | |
249 | |
250 ;;;###mh-autoload | |
251 (defun mh-mh-attach-file (filename type description attributes) | |
252 "Add a tag to insert a MIME message part from a file. | |
253 You are prompted for the FILENAME containing the object, the | |
254 media TYPE if it cannot be determined automatically, and a | |
255 content DESCRIPTION. In addition, you are also prompted for | |
256 additional ATTRIBUTES. | |
257 | |
258 See also \\[mh-mh-to-mime]." | |
259 (interactive (let ((filename (mml-minibuffer-read-file "Attach file: "))) | |
260 (list | |
261 filename | |
262 (mh-minibuffer-read-type filename) | |
263 (mml-minibuffer-read-description) | |
264 (read-string "Attributes: " | |
265 (concat "name=\"" | |
266 (file-name-nondirectory filename) | |
267 "\""))))) | |
268 (mh-mh-compose-type filename type description attributes)) | |
269 | |
270 (defun mh-mh-compose-type (filename type | |
271 &optional description attributes comment) | |
272 "Insert an MH-style directive to insert a file. | |
273 The file specified by FILENAME is encoded as TYPE. An optional | |
274 DESCRIPTION is used as the Content-Description field, optional | |
275 set of ATTRIBUTES and an optional COMMENT can also be included." | |
276 (beginning-of-line) | |
277 (insert "#" type) | |
278 (and attributes | |
279 (insert "; " attributes)) | |
280 (and comment | |
281 (insert " (" comment ")")) | |
282 (insert " [") | |
283 (and description | |
284 (insert description)) | |
285 (insert "] " (expand-file-name filename)) | |
286 (insert "\n")) | |
287 | |
288 ;;;###mh-autoload | |
289 (defun mh-mh-compose-anon-ftp (host filename type description) | |
290 "Add tag to include anonymous ftp reference to a file. | |
291 | |
292 You can have your message initiate an \"ftp\" transfer when the | |
293 recipient reads the message. You are prompted for the remote HOST | |
294 and FILENAME, the media TYPE, and the content DESCRIPTION. | |
295 | |
296 See also \\[mh-mh-to-mime]." | |
297 (interactive (list | |
298 (read-string "Remote host: ") | |
299 (read-string "Remote filename: ") | |
300 (mh-minibuffer-read-type "DUMMY-FILENAME") | |
301 (mml-minibuffer-read-description))) | |
302 (mh-mh-compose-external-type "anon-ftp" host filename | |
303 type description)) | |
304 | |
305 ;;;###mh-autoload | |
306 (defun mh-mh-compose-external-compressed-tar (host filename description) | |
307 "Add tag to include anonymous ftp reference to a compressed tar file. | |
308 | |
309 In addition to retrieving the file via anonymous \"ftp\" as per | |
310 the command \\[mh-mh-compose-anon-ftp], the file will also be | |
311 uncompressed and untarred. You are prompted for the remote HOST | |
312 and FILENAME and the content DESCRIPTION. | |
313 | |
314 See also \\[mh-mh-to-mime]." | |
315 (interactive (list | |
316 (read-string "Remote host: ") | |
317 (read-string "Remote filename: ") | |
318 (mml-minibuffer-read-description))) | |
319 (mh-mh-compose-external-type "anon-ftp" host filename | |
320 "application/octet-stream" | |
321 description | |
322 "type=tar; conversions=x-compress" | |
323 "mode=image")) | |
324 | |
325 ;;;###mh-autoload | |
326 (defun mh-mh-compose-external-type (access-type host filename type | |
327 &optional description | |
328 attributes parameters | |
329 comment) | |
330 "Add tag to refer to a remote file. | |
331 | |
332 This command is a general utility for referencing external files. | |
333 In fact, all of the other commands that insert directives to | |
334 access external files call this command. You are prompted for the | |
335 ACCESS-TYPE, remote HOST and FILENAME, and content TYPE. If you | |
336 provide a prefix argument, you are also prompted for a content | |
337 DESCRIPTION, ATTRIBUTES, PARAMETERS, and a COMMENT. | |
338 | |
339 See also \\[mh-mh-to-mime]." | |
340 (interactive (list | |
341 (completing-read "Access type: " mh-access-types) | |
342 (read-string "Remote host: ") | |
343 (read-string "Remote filename: ") | |
344 (mh-minibuffer-read-type "DUMMY-FILENAME") | |
345 (if current-prefix-arg (mml-minibuffer-read-description)) | |
346 (if current-prefix-arg (read-string "Attributes: ")) | |
347 (if current-prefix-arg (read-string "Parameters: ")) | |
348 (if current-prefix-arg (read-string "Comment: ")))) | |
349 (beginning-of-line) | |
350 (insert "#@" type) | |
351 (and attributes | |
352 (insert "; " attributes)) | |
353 (and comment | |
354 (insert " (" comment ") ")) | |
355 (insert " [") | |
356 (and description | |
357 (insert description)) | |
358 (insert "] ") | |
359 (insert "access-type=" access-type "; ") | |
360 (insert "site=" host) | |
361 (insert "; name=" (file-name-nondirectory filename)) | |
362 (let ((directory (file-name-directory filename))) | |
363 (and directory | |
364 (insert "; directory=\"" directory "\""))) | |
365 (and parameters | |
366 (insert "; " parameters)) | |
367 (insert "\n")) | |
368 | |
369 ;;;###mh-autoload | |
370 (defun mh-mh-forward-message (&optional description folder messages) | |
371 "Add tag to forward a message. | |
372 You are prompted for a content DESCRIPTION, the name of the | |
373 FOLDER in which the messages to forward are located, and the | |
374 MESSAGES' numbers. | |
375 | |
376 See also \\[mh-mh-to-mime]." | |
377 (interactive (list | |
378 (mml-minibuffer-read-description) | |
379 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) | |
380 (read-string (concat "Messages" | |
381 (if (numberp mh-sent-from-msg) | |
382 (format " (default %d): " | |
383 mh-sent-from-msg) | |
384 ": "))))) | |
385 (beginning-of-line) | |
386 (insert "#forw [") | |
387 (and description | |
388 (not (string= description "")) | |
389 (insert description)) | |
390 (insert "]") | |
391 (and folder | |
392 (not (string= folder "")) | |
393 (insert " " folder)) | |
394 (if (and messages | |
395 (not (string= messages ""))) | |
396 (let ((start (point))) | |
397 (insert " " messages) | |
398 (subst-char-in-region start (point) ?, ? )) | |
399 (if (numberp mh-sent-from-msg) | |
400 (insert " " (int-to-string mh-sent-from-msg)))) | |
401 (insert "\n")) | |
402 | |
403 ;;;###mh-autoload | |
404 (defun mh-mh-to-mime (&optional extra-args) | |
405 "Compose MIME message from MH-style directives. | |
406 | |
407 Typically, you send a message with attachments just like any other | |
408 message. However, you may take a sneak preview of the MIME encoding if | |
409 you wish by running this command. | |
410 | |
411 If you wish to pass additional arguments to \"mhbuild\" (\"mhn\") | |
412 to affect how it builds your message, use the option | |
413 `mh-mh-to-mime-args'. For example, you can build a consistency | |
414 check into the message by setting `mh-mh-to-mime-args' to | |
415 \"-check\". The recipient of your message can then run \"mhbuild | |
416 -check\" on the message--\"mhbuild\" (\"mhn\") will complain if | |
417 the message has been corrupted on the way. This command only | |
418 consults this option when given a prefix argument EXTRA-ARGS. | |
419 | |
420 The hook `mh-mh-to-mime-hook' is called after the message has been | |
421 formatted. | |
422 | |
423 The effects of this command can be undone by running | |
424 \\[mh-mh-to-mime-undo]." | |
425 (interactive "*P") | |
426 (mh-mh-quote-unescaped-sharp) | |
427 (save-buffer) | |
428 (message "Running %s..." (if (mh-variant-p 'nmh) "mhbuild" "mhn")) | |
429 (cond | |
430 ((mh-variant-p 'nmh) | |
431 (mh-exec-cmd-error nil | |
432 "mhbuild" | |
433 (if extra-args mh-mh-to-mime-args) | |
434 buffer-file-name)) | |
435 (t | |
436 (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) | |
437 "mhn" | |
438 (if extra-args mh-mh-to-mime-args) | |
439 buffer-file-name))) | |
440 (revert-buffer t t) | |
441 (message "Running %s...done" (if (mh-variant-p 'nmh) "mhbuild" "mhn")) | |
442 (run-hooks 'mh-mh-to-mime-hook)) | |
443 | |
444 (defun mh-mh-quote-unescaped-sharp () | |
445 "Quote \"#\" characters that haven't been quoted for \"mhbuild\". | |
446 If the \"#\" character is present in the first column, but it isn't | |
447 part of a MH-style directive then \"mhbuild\" gives an error. | |
448 This function will quote all such characters." | |
449 (save-excursion | |
450 (goto-char (point-min)) | |
451 (while (re-search-forward "^#" nil t) | |
452 (beginning-of-line) | |
453 (unless (mh-mh-directive-present-p (point) (line-end-position)) | |
454 (insert "#")) | |
455 (goto-char (line-end-position))))) | |
456 | |
457 ;;;###mh-autoload | |
458 (defun mh-mh-to-mime-undo (noconfirm) | |
459 "Undo effects of \\[mh-mh-to-mime]. | |
460 | |
461 It does this by reverting to a backup file. You are prompted to | |
462 confirm this action, but you can avoid the confirmation by adding | |
463 a prefix argument NOCONFIRM." | |
464 (interactive "*P") | |
465 (if (null buffer-file-name) | |
466 (error "Buffer does not seem to be associated with any file")) | |
467 (let ((backup-strings '("," "#")) | |
468 backup-file) | |
469 (while (and backup-strings | |
470 (not (file-exists-p | |
471 (setq backup-file | |
472 (concat (file-name-directory buffer-file-name) | |
473 (car backup-strings) | |
474 (file-name-nondirectory buffer-file-name) | |
475 ".orig"))))) | |
476 (setq backup-strings (cdr backup-strings))) | |
477 (or backup-strings | |
478 (error "Backup file for %s no longer exists" buffer-file-name)) | |
479 (or noconfirm | |
480 (yes-or-no-p (format "Revert buffer from file %s? " | |
481 backup-file)) | |
482 (error "Revert not confirmed")) | |
483 (let ((buffer-read-only nil)) | |
484 (erase-buffer) | |
485 (insert-file-contents backup-file)) | |
486 (after-find-file nil))) | |
487 | |
488 ;;;###mh-autoload | |
489 (defun mh-mh-directive-present-p (&optional begin end) | |
490 "Check if the text between BEGIN and END might be a MH-style directive. | |
491 The optional argument BEGIN defaults to the beginning of the | |
492 buffer, while END defaults to the the end of the buffer." | |
493 (unless begin (setq begin (point-min))) | |
494 (unless end (setq end (point-max))) | |
495 (save-excursion | |
496 (block 'search-for-mh-directive | |
497 (goto-char begin) | |
498 (while (re-search-forward "^#" end t) | |
499 (let ((s (buffer-substring-no-properties (point) (line-end-position)))) | |
500 (cond ((equal s "")) | |
501 ((string-match "^forw[ \t\n]+" s) | |
502 (return-from 'search-for-mh-directive t)) | |
503 (t (let ((first-token (car (split-string s "[ \t;@]")))) | |
504 (when (and first-token | |
505 (string-match mh-media-type-regexp | |
506 first-token)) | |
507 (return-from 'search-for-mh-directive t))))))) | |
508 nil))) | |
509 | |
510 | 70 |
511 | 71 |
512 ;;; MIME composition functions | 72 ;;; Variables |
513 | 73 |
514 ;;;###mh-autoload | 74 ;; This has to be a macro, since we do: (setf (mh-buffer-data) ...) |
515 (defun mh-mml-to-mime () | 75 ;;;###mh-autoload |
516 "Compose MIME message from MML tags. | 76 (defmacro mh-buffer-data () |
517 | 77 "Convenience macro to get the MIME data structures of the current buffer." |
518 Typically, you send a message with attachments just like any | 78 `(gethash (current-buffer) mh-globals-hash)) |
519 other message. However, you may take a sneak preview of the MIME | 79 |
520 encoding if you wish by running this command. | 80 ;; Structure to keep track of MIME handles on a per buffer basis. |
521 | 81 (mh-defstruct (mh-buffer-data (:conc-name mh-mime-) |
522 This action can be undone by running \\[undo]." | 82 (:constructor mh-make-buffer-data)) |
523 (interactive) | 83 (handles ()) ; List of MIME handles |
524 (require 'message) | 84 (handles-cache (make-hash-table)) ; Cache to avoid multiple decodes of |
525 (when mh-pgp-support-flag ;; This is only needed for PGP | 85 ; nested messages |
526 (message-options-set-recipient)) | 86 (parts-count 0) ; The button number is generated from |
527 (let ((saved-text (buffer-string)) | 87 ; this number |
528 (buffer (current-buffer)) | 88 (part-index-hash (make-hash-table))) ; Avoid incrementing the part number |
529 (modified-flag (buffer-modified-p))) | 89 ; for nested messages |
530 (condition-case err (mml-to-mime) | 90 |
531 (error | 91 (defvar mh-mm-inline-media-tests |
532 (with-current-buffer buffer | 92 `(("image/jpeg" |
533 (delete-region (point-min) (point-max)) | 93 mm-inline-image |
534 (insert saved-text) | 94 (lambda (handle) |
535 (set-buffer-modified-p modified-flag)) | 95 (mm-valid-and-fit-image-p 'jpeg handle))) |
536 (error (error-message-string err)))))) | 96 ("image/png" |
537 | 97 mm-inline-image |
538 ;;;###mh-autoload | 98 (lambda (handle) |
539 (defun mh-mml-forward-message (description folder message) | 99 (mm-valid-and-fit-image-p 'png handle))) |
540 "Forward a message as attachment. | 100 ("image/gif" |
541 | 101 mm-inline-image |
542 The function will prompt the user for a DESCRIPTION, a FOLDER and | 102 (lambda (handle) |
543 MESSAGE number." | 103 (mm-valid-and-fit-image-p 'gif handle))) |
544 (let ((msg (if (and (equal message "") (numberp mh-sent-from-msg)) | 104 ("image/tiff" |
545 mh-sent-from-msg | 105 mm-inline-image |
546 (string-to-number message)))) | 106 (lambda (handle) |
547 (cond ((integerp msg) | 107 (mm-valid-and-fit-image-p 'tiff handle)) ) |
548 (if (string= "" description) | 108 ("image/xbm" |
549 ;; Rationale: mml-attach-file constructs a malformed composition | 109 mm-inline-image |
550 ;; if the description string is empty. This fixes SF #625168. | 110 (lambda (handle) |
551 (mml-attach-file (format "%s%s/%d" | 111 (mm-valid-and-fit-image-p 'xbm handle))) |
552 mh-user-path (substring folder 1) msg) | 112 ("image/x-xbitmap" |
553 "message/rfc822") | 113 mm-inline-image |
554 (mml-attach-file (format "%s%s/%d" | 114 (lambda (handle) |
555 mh-user-path (substring folder 1) msg) | 115 (mm-valid-and-fit-image-p 'xbm handle))) |
556 "message/rfc822" | 116 ("image/xpm" |
557 description))) | 117 mm-inline-image |
558 (t (error "The message number, %s, is not a integer" msg))))) | 118 (lambda (handle) |
559 | 119 (mm-valid-and-fit-image-p 'xpm handle))) |
560 (defvar mh-mml-cryptographic-method-history ()) | 120 ("image/x-pixmap" |
561 | 121 mm-inline-image |
562 ;;;###mh-autoload | 122 (lambda (handle) |
563 (defun mh-mml-query-cryptographic-method () | 123 (mm-valid-and-fit-image-p 'xpm handle))) |
564 "Read the cryptographic method to use." | 124 ("image/bmp" |
565 (if current-prefix-arg | 125 mm-inline-image |
566 (let ((def (or (car mh-mml-cryptographic-method-history) | 126 (lambda (handle) |
567 mh-mml-method-default))) | 127 (mm-valid-and-fit-image-p 'bmp handle))) |
568 (completing-read (format "Method (default %s): " def) | 128 ("image/x-portable-bitmap" |
569 '(("pgp") ("pgpmime") ("smime")) | 129 mm-inline-image |
570 nil t nil 'mh-mml-cryptographic-method-history def)) | 130 (lambda (handle) |
571 mh-mml-method-default)) | 131 (mm-valid-and-fit-image-p 'pbm handle))) |
572 | 132 ("text/plain" mm-inline-text identity) |
573 ;;;###mh-autoload | 133 ("text/enriched" mm-inline-text identity) |
574 (defun mh-mml-attach-file (&optional disposition) | 134 ("text/richtext" mm-inline-text identity) |
575 "Add a tag to insert a MIME message part from a file. | 135 ("text/x-patch" mm-display-patch-inline |
576 | 136 (lambda (handle) |
577 You are prompted for the filename containing the object, the | 137 (locate-library "diff-mode"))) |
578 media type if it cannot be determined automatically, a content | 138 ("application/emacs-lisp" mm-display-elisp-inline identity) |
579 description and the DISPOSITION of the attachment. | 139 ("application/x-emacs-lisp" mm-display-elisp-inline identity) |
580 | 140 ("text/html" |
581 This is basically `mml-attach-file' from Gnus, modified such that a prefix | 141 ,(if (fboundp 'mm-inline-text-html) 'mm-inline-text-html 'mm-inline-text) |
582 argument yields an \"inline\" disposition and Content-Type is determined | 142 (lambda (handle) |
583 automatically." | 143 (or (and (boundp 'mm-inline-text-html-renderer) |
584 (let* ((file (mml-minibuffer-read-file "Attach file: ")) | 144 mm-inline-text-html-renderer) |
585 (type (mh-minibuffer-read-type file)) | 145 (and (boundp 'mm-text-html-renderer) mm-text-html-renderer)))) |
586 (description (mml-minibuffer-read-description)) | 146 ("text/x-vcard" |
587 (dispos (or disposition | 147 mm-inline-text-vcard |
588 (mml-minibuffer-read-disposition type)))) | 148 (lambda (handle) |
589 (mml-insert-empty-tag 'part 'type type 'filename file | 149 (or (featurep 'vcard) |
590 'disposition dispos 'description description))) | 150 (locate-library "vcard")))) |
591 | 151 ("message/delivery-status" mm-inline-text identity) |
592 ;; Shush compiler. | 152 ("message/rfc822" mh-mm-inline-message identity) |
593 (eval-when-compile (defvar mh-identity-pgg-default-user-id)) | 153 ;;("message/partial" mm-inline-partial identity) |
594 | 154 ;;("message/external-body" mm-inline-external-body identity) |
595 (defun mh-secure-message (method mode &optional identity) | 155 ("text/.*" mm-inline-text identity) |
596 "Add tag to encrypt or sign message. | 156 ("audio/wav" mm-inline-audio |
597 | 157 (lambda (handle) |
598 METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\". | 158 (and (or (featurep 'nas-sound) (featurep 'native-sound)) |
599 MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\". | 159 (device-sound-enabled-p)))) |
600 IDENTITY is optionally the default-user-id to use." | 160 ("audio/au" |
601 (if (not mh-pgp-support-flag) | 161 mm-inline-audio |
602 (error "Your version of Gnus does not support PGP/GPG") | 162 (lambda (handle) |
603 ;; Check the arguments | 163 (and (or (featurep 'nas-sound) (featurep 'native-sound)) |
604 (let ((valid-methods (list "pgpmime" "pgp" "smime")) | 164 (device-sound-enabled-p)))) |
605 (valid-modes (list "sign" "encrypt" "signencrypt" "none"))) | 165 ("application/pgp-signature" ignore identity) |
606 (if (not (member method valid-methods)) | 166 ("application/x-pkcs7-signature" ignore identity) |
607 (error "Method %s is invalid" method)) | 167 ("application/pkcs7-signature" ignore identity) |
608 (if (not (member mode valid-modes)) | 168 ("application/x-pkcs7-mime" ignore identity) |
609 (error "Mode %s is invalid" mode)) | 169 ("application/pkcs7-mime" ignore identity) |
610 (mml-unsecure-message) | 170 ("multipart/alternative" ignore identity) |
611 (if (not (string= mode "none")) | 171 ("multipart/mixed" ignore identity) |
612 (save-excursion | 172 ("multipart/related" ignore identity) |
613 (goto-char (point-min)) | 173 ;; Disable audio and image |
614 (mh-goto-header-end 1) | 174 ("audio/.*" ignore ignore) |
615 (if mh-identity-pgg-default-user-id | 175 ("image/.*" ignore ignore) |
616 (mml-insert-tag 'secure 'method method 'mode mode | 176 ;; Default to displaying as text |
617 'sender mh-identity-pgg-default-user-id) | 177 (".*" mm-inline-text mm-readable-p)) |
618 (mml-insert-tag 'secure 'method method 'mode mode))))))) | 178 "Alist of media types/tests saying whether types can be displayed inline.") |
619 | 179 |
620 ;;;###mh-autoload | 180 (defvar mh-mime-save-parts-directory nil |
621 (defun mh-mml-unsecure-message () | 181 "Default to use for `mh-mime-save-parts-default-directory'. |
622 "Remove any secure message tags." | 182 Set from last use.") |
623 (interactive) | |
624 (if (not mh-pgp-support-flag) | |
625 (error "Your version of Gnus does not support PGP/GPG") | |
626 (mml-unsecure-message))) | |
627 | |
628 ;;;###mh-autoload | |
629 (defun mh-mml-secure-message-sign (method) | |
630 "Add tag to sign the message. | |
631 | |
632 A proper multipart message is created for you when you send the | |
633 message. Use the command \\[mh-mml-unsecure-message] to remove | |
634 this tag. Use a prefix argument METHOD to be prompted for one of | |
635 the possible security methods (see `mh-mml-method-default')." | |
636 (interactive (list (mh-mml-query-cryptographic-method))) | |
637 (mh-secure-message method "sign" mh-identity-pgg-default-user-id)) | |
638 | |
639 ;;;###mh-autoload | |
640 (defun mh-mml-secure-message-encrypt (method) | |
641 "Add tag to encrypt the message. | |
642 | |
643 A proper multipart message is created for you when you send the | |
644 message. Use the command \\[mh-mml-unsecure-message] to remove | |
645 this tag. Use a prefix argument METHOD to be prompted for one of | |
646 the possible security methods (see `mh-mml-method-default')." | |
647 (interactive (list (mh-mml-query-cryptographic-method))) | |
648 (mh-secure-message method "encrypt" mh-identity-pgg-default-user-id)) | |
649 | |
650 ;;;###mh-autoload | |
651 (defun mh-mml-secure-message-signencrypt (method) | |
652 "Add tag to encrypt and sign the message. | |
653 | |
654 A proper multipart message is created for you when you send the | |
655 message. Use the command \\[mh-mml-unsecure-message] to remove | |
656 this tag. Use a prefix argument METHOD to be prompted for one of | |
657 the possible security methods (see `mh-mml-method-default')." | |
658 (interactive (list (mh-mml-query-cryptographic-method))) | |
659 (mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id)) | |
660 | |
661 ;;;###mh-autoload | |
662 (defun mh-mml-tag-present-p () | |
663 "Check if the current buffer has text which may be a MML tag." | |
664 (save-excursion | |
665 (goto-char (point-min)) | |
666 (re-search-forward | |
667 (concat | |
668 "\\(<#\\(mml\\|part\\)\\(.\\|\n\\)*>[ \n\t]*<#/\\(mml\\|part\\)>\\|" | |
669 "^<#secure.+>$\\)") | |
670 nil t))) | |
671 | |
672 | |
673 | |
674 ;;; MIME cleanup | |
675 | |
676 ;;;###mh-autoload | |
677 (defun mh-mime-cleanup () | |
678 "Free the decoded MIME parts." | |
679 (let ((mime-data (gethash (current-buffer) mh-globals-hash))) | |
680 ;; This is for Emacs, what about XEmacs? | |
681 (mh-funcall-if-exists remove-images (point-min) (point-max)) | |
682 (when mime-data | |
683 (mm-destroy-parts (mh-mime-handles mime-data)) | |
684 (remhash (current-buffer) mh-globals-hash)))) | |
685 | |
686 ;;;###mh-autoload | |
687 (defun mh-destroy-postponed-handles () | |
688 "Free MIME data for externally displayed MIME parts." | |
689 (let ((mime-data (mh-buffer-data))) | |
690 (when mime-data | |
691 (mm-destroy-parts (mh-mime-handles mime-data))) | |
692 (remhash (current-buffer) mh-globals-hash))) | |
693 | |
694 (defun mh-handle-set-external-undisplayer (folder handle function) | |
695 "Replacement for `mm-handle-set-external-undisplayer'. | |
696 | |
697 This is only called in recent versions of Gnus. The MIME handles | |
698 are stored in data structures corresponding to MH-E folder buffer | |
699 FOLDER instead of in Gnus (as in the original). The MIME part, | |
700 HANDLE is associated with the undisplayer FUNCTION." | |
701 (if (mm-keep-viewer-alive-p handle) | |
702 (let ((new-handle (copy-sequence handle))) | |
703 (mm-handle-set-undisplayer new-handle function) | |
704 (mm-handle-set-undisplayer handle nil) | |
705 (save-excursion | |
706 (set-buffer folder) | |
707 (push new-handle (mh-mime-handles (mh-buffer-data))))) | |
708 (mm-handle-set-undisplayer handle function))) | |
709 | |
710 | |
711 | |
712 ;;; MIME transformations | |
713 (eval-when-compile (require 'font-lock)) | |
714 | |
715 ;;;###mh-autoload | |
716 (defun mh-add-missing-mime-version-header () | |
717 "Some mail programs don't put a MIME-Version header. | |
718 I have seen this only in spam, so maybe we shouldn't fix | |
719 this ;-)" | |
720 (save-excursion | |
721 (goto-char (point-min)) | |
722 (re-search-forward "\n\n" nil t) | |
723 (save-restriction | |
724 (narrow-to-region (point-min) (point)) | |
725 (when (and (message-fetch-field "content-type") | |
726 (not (message-fetch-field "mime-version"))) | |
727 (goto-char (point-min)) | |
728 (insert "MIME-Version: 1.0\n"))))) | |
729 | |
730 (defun mh-small-show-buffer-p () | |
731 "Check if show buffer is small. | |
732 This is used to decide if smileys and graphical emphasis will be | |
733 displayed." | |
734 (let ((max nil)) | |
735 (when (and (boundp 'font-lock-maximum-size) font-lock-maximum-size) | |
736 (cond ((numberp font-lock-maximum-size) | |
737 (setq max font-lock-maximum-size)) | |
738 ((listp font-lock-maximum-size) | |
739 (setq max (cdr (or (assoc 'mh-show-mode font-lock-maximum-size) | |
740 (assoc t font-lock-maximum-size))))))) | |
741 (or (not (numberp max)) (>= (/ max 8) (buffer-size))))) | |
742 | |
743 ;;;###mh-autoload | |
744 (defun mh-display-smileys () | |
745 "Display smileys." | |
746 (when (and mh-graphical-smileys-flag (mh-small-show-buffer-p)) | |
747 (mh-funcall-if-exists smiley-region (point-min) (point-max)))) | |
748 | |
749 ;;;###mh-autoload | |
750 (defun mh-display-emphasis () | |
751 "Display graphical emphasis." | |
752 (when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p)) | |
753 (flet ((article-goto-body ())) ; shadow this function to do nothing | |
754 (save-excursion | |
755 (goto-char (point-min)) | |
756 (article-emphasize))))) | |
757 | 183 |
758 ;; Copied from gnus-art.el (should be checked for other cool things that can | 184 ;; Copied from gnus-art.el (should be checked for other cool things that can |
759 ;; be added to the buttons) | 185 ;; be added to the buttons) |
760 (defvar mh-mime-button-commands | 186 (defvar mh-mime-button-commands |
761 '((mh-press-button "\r" "Toggle Display"))) | 187 '((mh-press-button "\r" "Toggle Display"))) |
794 (define-key map [mouse-2] 'mh-push-button)) | 220 (define-key map [mouse-2] 'mh-push-button)) |
795 (mh-do-in-xemacs | 221 (mh-do-in-xemacs |
796 (define-key map '(button2) 'mh-push-button)) | 222 (define-key map '(button2) 'mh-push-button)) |
797 map)) | 223 map)) |
798 | 224 |
799 (defvar mh-mime-save-parts-directory nil | 225 |
800 "Default to use for `mh-mime-save-parts-default-directory'. | 226 |
801 Set from last use.") | 227 ;;; MH-Folder Commands |
228 | |
229 ;; Alphabetical. | |
230 | |
231 ;;;###mh-autoload | |
232 (defun mh-display-with-external-viewer (part-index) | |
233 "View attachment externally. | |
234 | |
235 If Emacs does not know how to view an attachment, you could save | |
236 it into a file and then run some program to open it. It is | |
237 easier, however, to launch the program directly from MH-E with | |
238 this command. While you'll most likely use this to view | |
239 spreadsheets and documents, it is also useful to use your browser | |
240 to view HTML attachments with higher fidelity than what Emacs can | |
241 provide. | |
242 | |
243 This command displays the attachment associated with the button | |
244 under the cursor. If the cursor is not located over a button, | |
245 then the cursor first moves to the next button, wrapping to the | |
246 beginning of the message if necessary. You can provide a numeric | |
247 prefix argument PART-INDEX to view the attachment labeled with | |
248 that number. | |
249 | |
250 This command tries to provide a reasonable default for the viewer | |
251 by calling the Emacs function `mailcap-mime-info'. This function | |
252 usually reads the file \"/etc/mailcap\"." | |
253 (interactive "P") | |
254 (when (consp part-index) (setq part-index (car part-index))) | |
255 (mh-folder-mime-action | |
256 part-index | |
257 #'(lambda () | |
258 (let* ((part (get-text-property (point) 'mh-data)) | |
259 (type (mm-handle-media-type part)) | |
260 (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x)))) | |
261 (mailcap-mime-info type 'all))) | |
262 (def (caar methods)) | |
263 (prompt (format "Viewer%s: " (if def | |
264 (format " (default %s)" def) | |
265 ""))) | |
266 (method (completing-read prompt methods nil nil nil nil def)) | |
267 (folder mh-show-folder-buffer) | |
268 (buffer-read-only nil)) | |
269 (when (string-match "^[^% \t]+$" method) | |
270 (setq method (concat method " %s"))) | |
271 (flet ((mm-handle-set-external-undisplayer (handle function) | |
272 (mh-handle-set-external-undisplayer folder handle function))) | |
273 (unwind-protect (mm-display-external part method) | |
274 (set-buffer-modified-p nil))))) | |
275 nil)) | |
276 | |
277 ;;;###mh-autoload | |
278 (defun mh-folder-inline-mime-part (part-index) | |
279 "Show attachment verbatim. | |
280 | |
281 You can view the raw contents of an attachment with this command. | |
282 This command displays (or hides) the contents of the attachment | |
283 associated with the button under the cursor verbatim. If the | |
284 cursor is not located over a button, then the cursor first moves | |
285 to the next button, wrapping to the beginning of the message if | |
286 necessary. | |
287 | |
288 You can also provide a numeric prefix argument PART-INDEX to view | |
289 the attachment labeled with that number." | |
290 (interactive "P") | |
291 (when (consp part-index) (setq part-index (car part-index))) | |
292 (mh-folder-mime-action part-index #'mh-mime-inline-part nil)) | |
293 | |
294 (defun mh-mime-inline-part () | |
295 "Toggle display of the raw MIME part." | |
296 (interactive) | |
297 (let* ((buffer-read-only nil) | |
298 (data (get-text-property (point) 'mh-data)) | |
299 (inserted-flag (get-text-property (point) 'mh-mime-inserted)) | |
300 (displayed-flag (mm-handle-displayed-p data)) | |
301 (point (point)) | |
302 start end) | |
303 (cond ((and data (not inserted-flag) (not displayed-flag)) | |
304 (let ((contents (mm-get-part data))) | |
305 (add-text-properties (line-beginning-position) (line-end-position) | |
306 '(mh-mime-inserted t)) | |
307 (setq start (point-marker)) | |
308 (forward-line 1) | |
309 (mm-insert-inline data contents) | |
310 (setq end (point-marker)) | |
311 (add-text-properties | |
312 start (progn (goto-char start) (line-end-position)) | |
313 `(mh-region (,start . ,end))))) | |
314 ((and data (or inserted-flag displayed-flag)) | |
315 (mh-press-button) | |
316 (message "MIME part already inserted"))) | |
317 (goto-char point) | |
318 (set-buffer-modified-p nil))) | |
319 | |
320 ;;;###mh-autoload | |
321 (defun mh-folder-save-mime-part (part-index) | |
322 "Save (output) attachment. | |
323 | |
324 This command saves the attachment associated with the button under the | |
325 cursor. If the cursor is not located over a button, then the cursor | |
326 first moves to the next button, wrapping to the beginning of the | |
327 message if necessary. | |
328 | |
329 You can also provide a numeric prefix argument PART-INDEX to save the | |
330 attachment labeled with that number. | |
331 | |
332 This command prompts you for a filename and suggests a specific name | |
333 if it is available." | |
334 (interactive "P") | |
335 (when (consp part-index) (setq part-index (car part-index))) | |
336 (mh-folder-mime-action part-index #'mh-mime-save-part nil)) | |
337 | |
338 (defun mh-mime-save-part () | |
339 "Save MIME part at point." | |
340 (interactive) | |
341 (let ((data (get-text-property (point) 'mh-data))) | |
342 (when data | |
343 (let ((mm-default-directory | |
344 (file-name-as-directory (or mh-mime-save-parts-directory | |
345 default-directory)))) | |
346 (mh-mm-save-part data) | |
347 (setq mh-mime-save-parts-directory mm-default-directory))))) | |
348 | |
349 ;;;###mh-autoload | |
350 (defun mh-folder-toggle-mime-part (part-index) | |
351 "View attachment. | |
352 | |
353 This command displays (or hides) the attachment associated with | |
354 the button under the cursor. If the cursor is not located over a | |
355 button, then the cursor first moves to the next button, wrapping | |
356 to the beginning of the message if necessary. This command has | |
357 the advantage over related commands of working from the MH-Folder | |
358 buffer. | |
359 | |
360 You can also provide a numeric prefix argument PART-INDEX to view | |
361 the attachment labeled with that number. If Emacs does not know | |
362 how to display the attachment, then Emacs offers to save the | |
363 attachment in a file." | |
364 (interactive "P") | |
365 (when (consp part-index) (setq part-index (car part-index))) | |
366 (mh-folder-mime-action part-index #'mh-press-button t)) | |
802 | 367 |
803 ;;;###mh-autoload | 368 ;;;###mh-autoload |
804 (defun mh-mime-save-parts (prompt) | 369 (defun mh-mime-save-parts (prompt) |
805 "Save attachments. | 370 "Save attachments. |
806 | 371 |
854 (if (> (buffer-size) initial-size) | 419 (if (> (buffer-size) initial-size) |
855 (save-window-excursion | 420 (save-window-excursion |
856 (switch-to-buffer-other-window mh-log-buffer) | 421 (switch-to-buffer-other-window mh-log-buffer) |
857 (sit-for 3)))))))) | 422 (sit-for 3)))))))) |
858 | 423 |
859 ;; Avoid errors if gnus-sum isn't loaded yet... | 424 ;;;###mh-autoload |
860 (defvar gnus-newsgroup-charset nil) | 425 (defun mh-toggle-mh-decode-mime-flag () |
861 (defvar gnus-newsgroup-name nil) | 426 "Toggle the value of `mh-decode-mime-flag'." |
427 (interactive) | |
428 (setq mh-decode-mime-flag (not mh-decode-mime-flag)) | |
429 (mh-show nil t) | |
430 (message "%s" (if mh-decode-mime-flag | |
431 "Processing attachments normally" | |
432 "Displaying raw message"))) | |
433 | |
434 ;;;###mh-autoload | |
435 (defun mh-toggle-mime-buttons () | |
436 "Toggle option `mh-display-buttons-for-inline-parts-flag'." | |
437 (interactive) | |
438 (setq mh-display-buttons-for-inline-parts-flag | |
439 (not mh-display-buttons-for-inline-parts-flag)) | |
440 (mh-show nil t)) | |
441 | |
442 | |
443 | |
444 ;;; MIME Display Routines | |
445 | |
446 (defun mh-mm-inline-message (handle) | |
447 "Display message, HANDLE. | |
448 The function decodes the message and displays it. It avoids | |
449 decoding the same message multiple times." | |
450 (let ((b (point)) | |
451 (clean-message-header mh-clean-message-header-flag) | |
452 (invisible-headers mh-invisible-header-fields-compiled) | |
453 (visible-headers nil)) | |
454 (save-excursion | |
455 (save-restriction | |
456 (narrow-to-region b b) | |
457 (mm-insert-part handle) | |
458 (mh-mime-display | |
459 (or (gethash handle (mh-mime-handles-cache (mh-buffer-data))) | |
460 (setf (gethash handle (mh-mime-handles-cache (mh-buffer-data))) | |
461 (let ((handles (mm-dissect-buffer nil))) | |
462 (if handles | |
463 (mm-uu-dissect-text-parts handles) | |
464 (setq handles (mm-uu-dissect))) | |
465 (setf (mh-mime-handles (mh-buffer-data)) | |
466 (mm-merge-handles | |
467 handles (mh-mime-handles (mh-buffer-data)))) | |
468 handles)))) | |
469 | |
470 (goto-char (point-min)) | |
471 (mh-show-xface) | |
472 (cond (clean-message-header | |
473 (mh-clean-msg-header (point-min) | |
474 invisible-headers | |
475 visible-headers) | |
476 (goto-char (point-min))) | |
477 (t | |
478 (mh-start-of-uncleaned-message))) | |
479 (mh-decode-message-header) | |
480 (mh-show-addr) | |
481 ;; The other highlighting types don't need anything special | |
482 (when (eq mh-highlight-citation-style 'gnus) | |
483 (mh-gnus-article-highlight-citation)) | |
484 (goto-char (point-min)) | |
485 (insert "\n------- Forwarded Message\n\n") | |
486 (mh-display-smileys) | |
487 (mh-display-emphasis) | |
488 (mm-handle-set-undisplayer | |
489 handle | |
490 `(lambda () | |
491 (let (buffer-read-only) | |
492 (if (fboundp 'remove-specifier) | |
493 ;; This is only valid on XEmacs. | |
494 (mapcar (lambda (prop) | |
495 (remove-specifier | |
496 (face-property 'default prop) (current-buffer))) | |
497 '(background background-pixmap foreground))) | |
498 (delete-region ,(point-min-marker) ,(point-max-marker))))))))) | |
499 | |
500 ;;;###mh-autoload | |
501 (defun mh-decode-message-header () | |
502 "Decode RFC2047 encoded message header fields." | |
503 (when mh-decode-mime-flag | |
504 (let ((buffer-read-only nil)) | |
505 (rfc2047-decode-region (point-min) (mh-mail-header-end))))) | |
506 | |
507 ;;;###mh-autoload | |
508 (defun mh-mime-display (&optional pre-dissected-handles) | |
509 "Display (and possibly decode) MIME handles. | |
510 Optional argument, PRE-DISSECTED-HANDLES is a list of MIME | |
511 handles. If present they are displayed otherwise the buffer is | |
512 parsed and then displayed." | |
513 (let ((handles ()) | |
514 (folder mh-show-folder-buffer) | |
515 (raw-message-data (buffer-string))) | |
516 (flet ((mm-handle-set-external-undisplayer | |
517 (handle function) | |
518 (mh-handle-set-external-undisplayer folder handle function))) | |
519 (goto-char (point-min)) | |
520 (unless (search-forward "\n\n" nil t) | |
521 (goto-char (point-max)) | |
522 (insert "\n\n")) | |
523 | |
524 (condition-case err | |
525 (progn | |
526 ;; If needed dissect the current buffer | |
527 (if pre-dissected-handles | |
528 (setq handles pre-dissected-handles) | |
529 (if (setq handles (mm-dissect-buffer nil)) | |
530 (mm-uu-dissect-text-parts handles) | |
531 (setq handles (mm-uu-dissect))) | |
532 (setf (mh-mime-handles (mh-buffer-data)) | |
533 (mm-merge-handles handles | |
534 (mh-mime-handles (mh-buffer-data)))) | |
535 (unless handles | |
536 (mh-decode-message-body))) | |
537 | |
538 (cond ((and handles | |
539 (or (not (stringp (car handles))) | |
540 (cdr handles))) | |
541 ;; Go to start of message body | |
542 (goto-char (point-min)) | |
543 (or (search-forward "\n\n" nil t) | |
544 (goto-char (point-max))) | |
545 | |
546 ;; Delete the body | |
547 (delete-region (point) (point-max)) | |
548 | |
549 ;; Display the MIME handles | |
550 (mh-mime-display-part handles)) | |
551 (t | |
552 (mh-signature-highlight)))) | |
553 (error | |
554 (message "Could not display body: %s" (error-message-string err)) | |
555 (delete-region (point-min) (point-max)) | |
556 (insert raw-message-data)))))) | |
862 | 557 |
863 (defun mh-decode-message-body () | 558 (defun mh-decode-message-body () |
864 "Decode message based on charset. | 559 "Decode message based on charset. |
865 If message has been encoded for transfer take that into account." | 560 If message has been encoded for transfer take that into account." |
866 (let (ct charset cte) | 561 (let (ct charset cte) |
880 (mm-decode-body charset | 575 (mm-decode-body charset |
881 (and cte (intern (downcase | 576 (and cte (intern (downcase |
882 (gnus-strip-whitespace cte)))) | 577 (gnus-strip-whitespace cte)))) |
883 (car ct)))))) | 578 (car ct)))))) |
884 | 579 |
885 ;;;###mh-autoload | |
886 (defun mh-toggle-mh-decode-mime-flag () | |
887 "Toggle the value of `mh-decode-mime-flag'." | |
888 (interactive) | |
889 (setq mh-decode-mime-flag (not mh-decode-mime-flag)) | |
890 (mh-show nil t) | |
891 (message "%s" (if mh-decode-mime-flag | |
892 "Processing attachments normally" | |
893 "Displaying raw message"))) | |
894 | |
895 ;;;###mh-autoload | |
896 (defun mh-decode-message-header () | |
897 "Decode RFC2047 encoded message header fields." | |
898 (when mh-decode-mime-flag | |
899 (let ((buffer-read-only nil)) | |
900 (rfc2047-decode-region (point-min) (mh-mail-header-end))))) | |
901 | |
902 ;;;###mh-autoload | |
903 (defun mh-mime-display (&optional pre-dissected-handles) | |
904 "Display (and possibly decode) MIME handles. | |
905 Optional argument, PRE-DISSECTED-HANDLES is a list of MIME | |
906 handles. If present they are displayed otherwise the buffer is | |
907 parsed and then displayed." | |
908 (let ((handles ()) | |
909 (folder mh-show-folder-buffer) | |
910 (raw-message-data (buffer-string))) | |
911 (flet ((mm-handle-set-external-undisplayer | |
912 (handle function) | |
913 (mh-handle-set-external-undisplayer folder handle function))) | |
914 (goto-char (point-min)) | |
915 (unless (search-forward "\n\n" nil t) | |
916 (goto-char (point-max)) | |
917 (insert "\n\n")) | |
918 | |
919 (condition-case err | |
920 (progn | |
921 ;; If needed dissect the current buffer | |
922 (if pre-dissected-handles | |
923 (setq handles pre-dissected-handles) | |
924 (if (setq handles (mm-dissect-buffer nil)) | |
925 (when (fboundp 'mm-uu-dissect-text-parts) | |
926 (mm-uu-dissect-text-parts handles)) | |
927 (setq handles (mm-uu-dissect))) | |
928 (setf (mh-mime-handles (mh-buffer-data)) | |
929 (mm-merge-handles handles | |
930 (mh-mime-handles (mh-buffer-data)))) | |
931 (unless handles (mh-decode-message-body))) | |
932 | |
933 (cond ((and handles | |
934 (or (not (stringp (car handles))) (cdr handles))) | |
935 ;; Goto start of message body | |
936 (goto-char (point-min)) | |
937 (or (search-forward "\n\n" nil t) (goto-char (point-max))) | |
938 | |
939 ;; Delete the body | |
940 (delete-region (point) (point-max)) | |
941 | |
942 ;; Display the MIME handles | |
943 (mh-mime-display-part handles)) | |
944 (t (mh-signature-highlight)))) | |
945 (error | |
946 (message "Could not display body: %s" (error-message-string err)) | |
947 (delete-region (point-min) (point-max)) | |
948 (insert raw-message-data)))))) | |
949 | |
950 (defun mh-mime-display-part (handle) | 580 (defun mh-mime-display-part (handle) |
951 "Decides the viewer to call based on the type of HANDLE." | 581 "Decides the viewer to call based on the type of HANDLE." |
952 (cond ((null handle) nil) | 582 (cond ((null handle) |
583 nil) | |
953 ((not (stringp (car handle))) | 584 ((not (stringp (car handle))) |
954 (mh-mime-display-single handle)) | 585 (mh-mime-display-single handle)) |
955 ((equal (car handle) "multipart/alternative") | 586 ((equal (car handle) "multipart/alternative") |
956 (mh-mime-display-alternative (cdr handle))) | 587 (mh-mime-display-alternative (cdr handle))) |
957 ((and mh-pgp-support-flag | 588 ((and mh-pgp-support-flag |
958 (or (equal (car handle) "multipart/signed") | 589 (or (equal (car handle) "multipart/signed") |
959 (equal (car handle) "multipart/encrypted"))) | 590 (equal (car handle) "multipart/encrypted"))) |
960 (mh-mime-display-security handle)) | 591 (mh-mime-display-security handle)) |
961 (t (mh-mime-display-mixed (cdr handle))))) | 592 (t |
593 (mh-mime-display-mixed (cdr handle))))) | |
594 | |
595 (defun mh-mime-display-mixed (handles) | |
596 "Display the list of MIME parts, HANDLES recursively." | |
597 (mapcar #'mh-mime-display-part handles)) | |
962 | 598 |
963 (defun mh-mime-display-alternative (handles) | 599 (defun mh-mime-display-alternative (handles) |
964 "Choose among the alternatives, HANDLES the part that will be displayed. | 600 "Choose among the alternatives, HANDLES the part that will be displayed. |
965 If no part is preferred then all the parts are displayed." | 601 If no part is preferred then all the parts are displayed." |
966 (let* ((preferred (mm-preferred-alternative handles)) | 602 (let* ((preferred (mm-preferred-alternative handles)) |
967 (others (loop for x in handles unless (eq x preferred) collect x))) | 603 (others (loop for x in handles unless (eq x preferred) collect x))) |
968 (cond ((and preferred (stringp (car preferred))) | 604 (cond ((and preferred |
605 (stringp (car preferred))) | |
969 (mh-mime-display-part preferred) | 606 (mh-mime-display-part preferred) |
970 (mh-mime-maybe-display-alternatives others)) | 607 (mh-mime-maybe-display-alternatives others)) |
971 (preferred | 608 (preferred |
972 (save-restriction | 609 (save-restriction |
973 (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) | 610 (narrow-to-region (point) (if (eobp) (point) (1+ (point)))) |
974 (mh-mime-display-single preferred) | 611 (mh-mime-display-single preferred) |
975 (mh-mime-maybe-display-alternatives others) | 612 (mh-mime-maybe-display-alternatives others) |
976 (goto-char (point-max)))) | 613 (goto-char (point-max)))) |
977 (t (mh-mime-display-mixed handles))))) | 614 (t |
615 (mh-mime-display-mixed handles))))) | |
978 | 616 |
979 (defun mh-mime-maybe-display-alternatives (alternatives) | 617 (defun mh-mime-maybe-display-alternatives (alternatives) |
980 "Show buttons for ALTERNATIVES. | 618 "Show buttons for ALTERNATIVES. |
981 If `mh-mime-display-alternatives-flag' is non-nil then display | 619 If `mh-mime-display-alternatives-flag' is non-nil then display |
982 buttons for alternative parts that are usually suppressed." | 620 buttons for alternative parts that are usually suppressed." |
986 (dolist (x alternatives) | 624 (dolist (x alternatives) |
987 (insert "\n") | 625 (insert "\n") |
988 (mh-insert-mime-button x (mh-mime-part-index x) nil)) | 626 (mh-insert-mime-button x (mh-mime-part-index x) nil)) |
989 (insert "\n----------------------------------------------------\n"))) | 627 (insert "\n----------------------------------------------------\n"))) |
990 | 628 |
991 (defun mh-mime-display-mixed (handles) | 629 (defun mh-mime-display-security (handle) |
992 "Display the list of MIME parts, HANDLES recursively." | 630 "Display PGP encrypted/signed message, HANDLE." |
993 (mapcar #'mh-mime-display-part handles)) | 631 (save-restriction |
994 | 632 (narrow-to-region (point) (point)) |
995 (defun mh-mime-part-index (handle) | 633 (insert "\n") |
996 "Generate the button number for MIME part, HANDLE. | 634 (mh-insert-mime-security-button handle) |
997 Notice that a hash table is used to display the same number when | 635 (mh-mime-display-mixed (cdr handle)) |
998 buttons need to be displayed multiple times (for instance when | 636 (insert "\n") |
999 nested messages are opened)." | 637 (let ((mh-mime-security-button-line-format |
1000 (or (gethash handle (mh-mime-part-index-hash (mh-buffer-data))) | 638 mh-mime-security-button-end-line-format)) |
1001 (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data))) | 639 (mh-insert-mime-security-button handle)) |
1002 (incf (mh-mime-parts-count (mh-buffer-data)))))) | 640 (mm-set-handle-multipart-parameter |
1003 | 641 handle 'mh-region (cons (point-min-marker) (point-max-marker))))) |
1004 (defun mh-small-image-p (handle) | |
1005 "Decide whether HANDLE is a \"small\" image that can be displayed inline. | |
1006 This is only useful if a Content-Disposition header is not present." | |
1007 (let ((media-test (caddr (assoc (car (mm-handle-type handle)) | |
1008 mh-mm-inline-media-tests))) | |
1009 (mm-inline-large-images t)) | |
1010 (and media-test | |
1011 (equal (mm-handle-media-supertype handle) "image") | |
1012 (funcall media-test handle) ; Since mm-inline-large-images is T, | |
1013 ; this only tells us if the image is | |
1014 ; something that emacs can display | |
1015 (let* ((image (mm-get-image handle))) | |
1016 (or (mh-do-in-xemacs | |
1017 (and (mh-funcall-if-exists glyphp image) | |
1018 (< (glyph-width image) | |
1019 (or mh-max-inline-image-width (window-pixel-width))) | |
1020 (< (glyph-height image) | |
1021 (or mh-max-inline-image-height | |
1022 (window-pixel-height))))) | |
1023 (mh-do-in-gnu-emacs | |
1024 (let ((size (mh-funcall-if-exists image-size image))) | |
1025 (and size | |
1026 (< (cdr size) (or mh-max-inline-image-height | |
1027 (1- (window-height)))) | |
1028 (< (car size) (or mh-max-inline-image-width | |
1029 (window-width))))))))))) | |
1030 | |
1031 (defun mh-inline-vcard-p (handle) | |
1032 "Decide if HANDLE is a vcard that must be displayed inline." | |
1033 (let ((type (mm-handle-type handle))) | |
1034 (and (or (featurep 'vcard) (fboundp 'vcard-pretty-print)) | |
1035 (consp type) | |
1036 (equal (car type) "text/x-vcard") | |
1037 (save-excursion | |
1038 (save-restriction | |
1039 (widen) | |
1040 (goto-char (point-min)) | |
1041 (not (mh-signature-separator-p))))))) | |
1042 | 642 |
1043 (defun mh-mime-display-single (handle) | 643 (defun mh-mime-display-single (handle) |
1044 "Display a leaf node, HANDLE in the MIME tree." | 644 "Display a leaf node, HANDLE in the MIME tree." |
1045 (let* ((type (mm-handle-media-type handle)) | 645 (let* ((type (mm-handle-media-type handle)) |
1046 (small-image-flag (mh-small-image-p handle)) | 646 (small-image-flag (mh-small-image-p handle)) |
1065 (equal type "application/pgp-signature")) | 665 (equal type "application/pgp-signature")) |
1066 nil) ; skip signatures as they are already handled... | 666 nil) ; skip signatures as they are already handled... |
1067 ((not displayp) | 667 ((not displayp) |
1068 (insert "\n") | 668 (insert "\n") |
1069 (mh-insert-mime-button handle (mh-mime-part-index handle) nil)) | 669 (mh-insert-mime-button handle (mh-mime-part-index handle) nil)) |
1070 ((and displayp (not mh-display-buttons-for-inline-parts-flag)) | 670 ((and displayp |
1071 (or (mm-display-part handle) (mm-display-part handle)) | 671 (not mh-display-buttons-for-inline-parts-flag)) |
672 (or (mm-display-part handle) | |
673 (mm-display-part handle)) | |
1072 (mh-signature-highlight handle)) | 674 (mh-signature-highlight handle)) |
1073 ((and displayp mh-display-buttons-for-inline-parts-flag) | 675 ((and displayp |
676 mh-display-buttons-for-inline-parts-flag) | |
1074 (insert "\n") | 677 (insert "\n") |
1075 (mh-insert-mime-button handle (mh-mime-part-index handle) nil) | 678 (mh-insert-mime-button handle (mh-mime-part-index handle) nil) |
1076 (forward-line -1) | 679 (forward-line -1) |
1077 (mh-mm-display-part handle))) | 680 (mh-mm-display-part handle))) |
1078 (goto-char (point-max))))) | 681 (goto-char (point-max))))) |
1079 | |
1080 (defun mh-signature-highlight (&optional handle) | |
1081 "Highlight message signature in HANDLE. | |
1082 The optional argument, HANDLE is a MIME handle if the function is | |
1083 being used to highlight the signature in a MIME part." | |
1084 (let ((regexp | |
1085 (cond ((not handle) "^-- $") | |
1086 ((not (and (equal (mm-handle-media-supertype handle) "text") | |
1087 (equal (mm-handle-media-subtype handle) "html"))) | |
1088 "^-- $") | |
1089 ((eq (mh-mm-text-html-renderer) 'lynx) "^ --$") | |
1090 (t "^--$")))) | |
1091 (save-excursion | |
1092 (goto-char (point-max)) | |
1093 (when (re-search-backward regexp nil t) | |
1094 (mh-do-in-gnu-emacs | |
1095 (let ((ov (make-overlay (point) (point-max)))) | |
1096 (overlay-put ov 'face 'mh-show-signature) | |
1097 (overlay-put ov 'evaporate t))) | |
1098 (mh-do-in-xemacs | |
1099 (set-extent-property (make-extent (point) (point-max)) | |
1100 'face 'mh-show-signature)))))) | |
1101 | |
1102 (mh-do-in-xemacs | |
1103 (defvar dots) | |
1104 (defvar type)) | |
1105 | |
1106 (defun mh-insert-mime-button (handle index displayed) | |
1107 "Insert MIME button for HANDLE. | |
1108 INDEX is the part number that will be DISPLAYED. It is also used | |
1109 by commands like \"K v\" which operate on individual MIME parts." | |
1110 ;; The button could be displayed by a previous decode. In that case | |
1111 ;; undisplay it if we need a hidden button. | |
1112 (when (and (mm-handle-displayed-p handle) (not displayed)) | |
1113 (mm-display-part handle)) | |
1114 (let ((name (or (mail-content-type-get (mm-handle-type handle) 'name) | |
1115 (mail-content-type-get (mm-handle-disposition handle) | |
1116 'filename) | |
1117 (mail-content-type-get (mm-handle-type handle) 'url) | |
1118 "")) | |
1119 (type (mm-handle-media-type handle)) | |
1120 (description (mail-decode-encoded-word-string | |
1121 (or (mm-handle-description handle) ""))) | |
1122 (dots (if (or displayed (mm-handle-displayed-p handle)) " " "...")) | |
1123 long-type begin end) | |
1124 (if (string-match ".*/" name) (setq name (substring name (match-end 0)))) | |
1125 (setq long-type (concat type (and (not (equal name "")) | |
1126 (concat "; " name)))) | |
1127 (unless (equal description "") | |
1128 (setq long-type (concat " --- " long-type))) | |
1129 (unless (bolp) (insert "\n")) | |
1130 (setq begin (point)) | |
1131 (gnus-eval-format | |
1132 mh-mime-button-line-format mh-mime-button-line-format-alist | |
1133 `(,@(gnus-local-map-property mh-mime-button-map) | |
1134 mh-callback mh-mm-display-part | |
1135 mh-part ,index | |
1136 mh-data ,handle)) | |
1137 (setq end (point)) | |
1138 (widget-convert-button | |
1139 'link begin end | |
1140 :mime-handle handle | |
1141 :action 'mh-widget-press-button | |
1142 :button-keymap mh-mime-button-map | |
1143 :help-echo | |
1144 "Mouse-2 click or press RET (in show buffer) to toggle display") | |
1145 (dolist (ov (mh-funcall-if-exists overlays-in begin end)) | |
1146 (mh-funcall-if-exists overlay-put ov 'evaporate t)))) | |
1147 | 682 |
1148 ;; There is a bug in Gnus inline image display due to which an extra line | 683 ;; There is a bug in Gnus inline image display due to which an extra line |
1149 ;; gets inserted every time it is viewed. To work around that problem we are | 684 ;; gets inserted every time it is viewed. To work around that problem we are |
1150 ;; using an extra property 'mh-region to remember the region that is added | 685 ;; using an extra property 'mh-region to remember the region that is added |
1151 ;; when the button is clicked. The region is then deleted to make sure that | 686 ;; when the button is clicked. The region is then deleted to make sure that |
1212 (goto-char point) | 747 (goto-char point) |
1213 (when region | 748 (when region |
1214 (add-text-properties (line-beginning-position) (line-end-position) | 749 (add-text-properties (line-beginning-position) (line-end-position) |
1215 `(mh-region ,region))))))) | 750 `(mh-region ,region))))))) |
1216 | 751 |
1217 ;;;###mh-autoload | 752 (defun mh-mime-part-index (handle) |
1218 (defun mh-press-button () | 753 "Generate the button number for MIME part, HANDLE. |
1219 "View contents of button. | 754 Notice that a hash table is used to display the same number when |
1220 | 755 buttons need to be displayed multiple times (for instance when |
1221 This command is a toggle so if you use it again on the same | 756 nested messages are opened)." |
1222 attachment, the attachment is hidden." | 757 (or (gethash handle (mh-mime-part-index-hash (mh-buffer-data))) |
1223 (interactive) | 758 (setf (gethash handle (mh-mime-part-index-hash (mh-buffer-data))) |
1224 (let ((mm-inline-media-tests mh-mm-inline-media-tests) | 759 (incf (mh-mime-parts-count (mh-buffer-data)))))) |
1225 (data (get-text-property (point) 'mh-data)) | 760 |
1226 (function (get-text-property (point) 'mh-callback)) | 761 (defun mh-small-image-p (handle) |
1227 (buffer-read-only nil) | 762 "Decide whether HANDLE is a \"small\" image that can be displayed inline. |
1228 (folder mh-show-folder-buffer)) | 763 This is only useful if a Content-Disposition header is not present." |
1229 (flet ((mm-handle-set-external-undisplayer | 764 (let ((media-test (caddr (assoc (car (mm-handle-type handle)) |
1230 (handle function) | 765 mh-mm-inline-media-tests))) |
1231 (mh-handle-set-external-undisplayer folder handle function))) | 766 (mm-inline-large-images t)) |
1232 (when (and function (eolp)) | 767 (and media-test |
1233 (backward-char)) | 768 (equal (mm-handle-media-supertype handle) "image") |
1234 (unwind-protect (and function (funcall function data)) | 769 (funcall media-test handle) ; Since mm-inline-large-images is T, |
1235 (set-buffer-modified-p nil))))) | 770 ; this only tells us if the image is |
1236 | 771 ; something that emacs can display |
1237 ;;;###mh-autoload | 772 (let* ((image (mm-get-image handle))) |
1238 (defun mh-push-button (event) | 773 (or (mh-do-in-xemacs |
1239 "Click MIME button for EVENT. | 774 (and (mh-funcall-if-exists glyphp image) |
1240 | 775 (< (glyph-width image) |
1241 If the MIME part is visible then it is removed. Otherwise the | 776 (or mh-max-inline-image-width (window-pixel-width))) |
1242 part is displayed. This function is called when the mouse is used | 777 (< (glyph-height image) |
1243 to click the MIME button." | 778 (or mh-max-inline-image-height |
1244 (interactive "e") | 779 (window-pixel-height))))) |
1245 (mh-do-at-event-location event | 780 (mh-do-in-gnu-emacs |
1246 (let ((folder mh-show-folder-buffer) | 781 (let ((size (mh-funcall-if-exists image-size image))) |
1247 (mm-inline-media-tests mh-mm-inline-media-tests) | 782 (and size |
1248 (data (get-text-property (point) 'mh-data)) | 783 (< (cdr size) (or mh-max-inline-image-height |
1249 (function (get-text-property (point) 'mh-callback))) | 784 (1- (window-height)))) |
1250 (flet ((mm-handle-set-external-undisplayer (handle func) | 785 (< (car size) (or mh-max-inline-image-width |
1251 (mh-handle-set-external-undisplayer folder handle func))) | 786 (window-width))))))))))) |
1252 (and function (funcall function data)))))) | 787 |
1253 | 788 (defun mh-inline-vcard-p (handle) |
1254 ;;;###mh-autoload | 789 "Decide if HANDLE is a vcard that must be displayed inline." |
1255 (defun mh-mime-save-part () | 790 (let ((type (mm-handle-type handle))) |
1256 "Save MIME part at point." | 791 (and (or (featurep 'vcard) (fboundp 'vcard-pretty-print)) |
1257 (interactive) | 792 (consp type) |
1258 (let ((data (get-text-property (point) 'mh-data))) | 793 (equal (car type) "text/x-vcard") |
1259 (when data | 794 (save-excursion |
1260 (let ((mm-default-directory | 795 (save-restriction |
1261 (file-name-as-directory (or mh-mime-save-parts-directory | 796 (widen) |
1262 default-directory)))) | 797 (goto-char (point-min)) |
1263 (mh-mm-save-part data) | 798 (not (mh-signature-separator-p))))))) |
1264 (setq mh-mime-save-parts-directory mm-default-directory))))) | 799 |
1265 | 800 (defun mh-signature-highlight (&optional handle) |
1266 ;;;###mh-autoload | 801 "Highlight message signature in HANDLE. |
1267 (defun mh-mime-inline-part () | 802 The optional argument, HANDLE is a MIME handle if the function is |
1268 "Toggle display of the raw MIME part." | 803 being used to highlight the signature in a MIME part." |
1269 (interactive) | 804 (let ((regexp |
1270 (let* ((buffer-read-only nil) | 805 (cond ((not handle) "^-- $") |
1271 (data (get-text-property (point) 'mh-data)) | 806 ((not (and (equal (mm-handle-media-supertype handle) "text") |
1272 (inserted-flag (get-text-property (point) 'mh-mime-inserted)) | 807 (equal (mm-handle-media-subtype handle) "html"))) |
1273 (displayed-flag (mm-handle-displayed-p data)) | 808 "^-- $") |
1274 (point (point)) | 809 ((eq (mh-mm-text-html-renderer) 'lynx) "^ --$") |
1275 start end) | 810 (t "^--$")))) |
1276 (cond ((and data (not inserted-flag) (not displayed-flag)) | 811 (save-excursion |
1277 (let ((contents (mm-get-part data))) | 812 (goto-char (point-max)) |
1278 (add-text-properties (line-beginning-position) (line-end-position) | 813 (when (re-search-backward regexp nil t) |
1279 '(mh-mime-inserted t)) | 814 (mh-do-in-gnu-emacs |
1280 (setq start (point-marker)) | 815 (let ((ov (make-overlay (point) (point-max)))) |
1281 (forward-line 1) | 816 (overlay-put ov 'face 'mh-show-signature) |
1282 (mm-insert-inline data contents) | 817 (overlay-put ov 'evaporate t))) |
1283 (setq end (point-marker)) | 818 (mh-do-in-xemacs |
1284 (add-text-properties | 819 (set-extent-property (make-extent (point) (point-max)) |
1285 start (progn (goto-char start) (line-end-position)) | 820 'face 'mh-show-signature)))))) |
1286 `(mh-region (,start . ,end))))) | 821 |
1287 ((and data (or inserted-flag displayed-flag)) | 822 |
1288 (mh-press-button) | 823 |
1289 (message "MIME part already inserted"))) | 824 ;;; Button Display |
1290 (goto-char point) | 825 |
1291 (set-buffer-modified-p nil))) | 826 ;; Shush compiler. |
1292 | 827 (eval-when-compile (mh-do-in-xemacs (defvar dots) (defvar type) (defvar ov))) |
1293 ;;;###mh-autoload | 828 |
1294 (defun mh-display-with-external-viewer (part-index) | 829 (defun mh-insert-mime-button (handle index displayed) |
1295 "View attachment externally. | 830 "Insert MIME button for HANDLE. |
1296 | 831 INDEX is the part number that will be DISPLAYED. It is also used |
1297 If Emacs does not know how to view an attachment, you could save | 832 by commands like \"K v\" which operate on individual MIME parts." |
1298 it into a file and then run some program to open it. It is | 833 ;; The button could be displayed by a previous decode. In that case |
1299 easier, however, to launch the program directly from MH-E with | 834 ;; undisplay it if we need a hidden button. |
1300 this command. While you'll most likely use this to view | 835 (when (and (mm-handle-displayed-p handle) (not displayed)) |
1301 spreadsheets and documents, it is also useful to use your browser | 836 (mm-display-part handle)) |
1302 to view HTML attachments with higher fidelity than what Emacs can | 837 (let ((name (or (mail-content-type-get (mm-handle-type handle) 'name) |
1303 provide. | 838 (mail-content-type-get (mm-handle-disposition handle) |
1304 | 839 'filename) |
1305 This command displays the attachment associated with the button | 840 (mail-content-type-get (mm-handle-type handle) 'url) |
1306 under the cursor. If the cursor is not located over a button, | 841 "")) |
1307 then the cursor first moves to the next button, wrapping to the | 842 (type (mm-handle-media-type handle)) |
1308 beginning of the message if necessary. You can provide a numeric | 843 (description (mail-decode-encoded-word-string |
1309 prefix argument PART-INDEX to view the attachment labeled with | 844 (or (mm-handle-description handle) ""))) |
1310 that number. | 845 (dots (if (or displayed (mm-handle-displayed-p handle)) " " "...")) |
1311 | 846 long-type begin end) |
1312 This command tries to provide a reasonable default for the viewer | 847 (if (string-match ".*/" name) (setq name (substring name (match-end 0)))) |
1313 by calling the Emacs function `mailcap-mime-info'. This function | 848 (setq long-type (concat type (and (not (equal name "")) |
1314 usually reads the file \"/etc/mailcap\"." | 849 (concat "; " name)))) |
1315 (interactive "P") | 850 (unless (equal description "") |
1316 (when (consp part-index) (setq part-index (car part-index))) | 851 (setq long-type (concat " --- " long-type))) |
1317 (mh-folder-mime-action | 852 (unless (bolp) (insert "\n")) |
1318 part-index | 853 (setq begin (point)) |
1319 #'(lambda () | 854 (gnus-eval-format |
1320 (let* ((part (get-text-property (point) 'mh-data)) | 855 mh-mime-button-line-format mh-mime-button-line-format-alist |
1321 (type (mm-handle-media-type part)) | 856 `(,@(gnus-local-map-property mh-mime-button-map) |
1322 (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x)))) | 857 mh-callback mh-mm-display-part |
1323 (mailcap-mime-info type 'all))) | 858 mh-part ,index |
1324 (def (caar methods)) | 859 mh-data ,handle)) |
1325 (prompt (format "Viewer%s: " (if def | 860 (setq end (point)) |
1326 (format " (default %s)" def) | 861 (widget-convert-button |
1327 ""))) | 862 'link begin end |
1328 (method (completing-read prompt methods nil nil nil nil def)) | 863 :mime-handle handle |
1329 (folder mh-show-folder-buffer) | 864 :action 'mh-widget-press-button |
1330 (buffer-read-only nil)) | 865 :button-keymap mh-mime-button-map |
1331 (when (string-match "^[^% \t]+$" method) | 866 :help-echo |
1332 (setq method (concat method " %s"))) | 867 "Mouse-2 click or press RET (in show buffer) to toggle display") |
1333 (flet ((mm-handle-set-external-undisplayer (handle function) | 868 (dolist (ov (mh-funcall-if-exists overlays-in begin end)) |
1334 (mh-handle-set-external-undisplayer folder handle function))) | 869 (mh-funcall-if-exists overlay-put ov 'evaporate t)))) |
1335 (unwind-protect (mm-display-external part method) | |
1336 (set-buffer-modified-p nil))))) | |
1337 nil)) | |
1338 | |
1339 (defun mh-widget-press-button (widget el) | |
1340 "Callback for widget, WIDGET. | |
1341 Parameter EL is unused." | |
1342 (goto-char (widget-get widget :from)) | |
1343 (mh-press-button)) | |
1344 | |
1345 (defun mh-mime-display-security (handle) | |
1346 "Display PGP encrypted/signed message, HANDLE." | |
1347 (save-restriction | |
1348 (narrow-to-region (point) (point)) | |
1349 (insert "\n") | |
1350 (mh-insert-mime-security-button handle) | |
1351 (mh-mime-display-mixed (cdr handle)) | |
1352 (insert "\n") | |
1353 (let ((mh-mime-security-button-line-format | |
1354 mh-mime-security-button-end-line-format)) | |
1355 (mh-insert-mime-security-button handle)) | |
1356 (mm-set-handle-multipart-parameter | |
1357 handle 'mh-region (cons (point-min-marker) (point-max-marker))))) | |
1358 | |
1359 ;; I rewrote the security part because Gnus doesn't seem to ever minimize | |
1360 ;; the button. That is once the mime-security button is pressed there seems | |
1361 ;; to be no way of getting rid of the inserted text. | |
1362 (defun mh-mime-security-show-details (handle) | |
1363 "Toggle display of detailed security info for HANDLE." | |
1364 (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) | |
1365 (when details | |
1366 (let ((mh-mime-security-button-pressed | |
1367 (not (get-text-property (point) 'mh-button-pressed))) | |
1368 (mh-mime-security-button-line-format | |
1369 (get-text-property (point) 'mh-line-format))) | |
1370 (forward-char -1) | |
1371 (while (eq (get-text-property (point) 'mh-line-format) | |
1372 mh-mime-security-button-line-format) | |
1373 (forward-char -1)) | |
1374 (forward-char) | |
1375 (save-restriction | |
1376 (narrow-to-region (point) (point)) | |
1377 (mh-insert-mime-security-button handle)) | |
1378 (delete-region | |
1379 (point) | |
1380 (or (text-property-not-all | |
1381 (point) (point-max) | |
1382 'mh-line-format mh-mime-security-button-line-format) | |
1383 (point-max))) | |
1384 (forward-line -1))))) | |
1385 | |
1386 (defun mh-mime-security-button-face (info) | |
1387 "Return the button face to use for encrypted/signed mail based on INFO." | |
1388 (cond ((string-match "OK" info) ;Decrypted mail | |
1389 'mh-show-pgg-good) | |
1390 ((string-match "Failed" info) ;Decryption failed or signature invalid | |
1391 'mh-show-pgg-bad) | |
1392 ((string-match "Undecided" info);Unprocessed mail | |
1393 'mh-show-pgg-unknown) | |
1394 ((string-match "Untrusted" info);Key not trusted | |
1395 'mh-show-pgg-unknown) | |
1396 (t | |
1397 'mh-show-pgg-good))) | |
1398 | |
1399 (defun mh-mime-security-press-button (handle) | |
1400 "Callback from security button for part HANDLE." | |
1401 (if (mm-handle-multipart-ctl-parameter handle 'gnus-info) | |
1402 (mh-mime-security-show-details handle) | |
1403 (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region)) | |
1404 point) | |
1405 (setq point (point)) | |
1406 (goto-char (car region)) | |
1407 (delete-region (car region) (cdr region)) | |
1408 (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer) | |
1409 (let* ((mm-verify-option 'known) | |
1410 (mm-decrypt-option 'known) | |
1411 (new (mm-possibly-verify-or-decrypt (cdr handle) handle))) | |
1412 (unless (eq new (cdr handle)) | |
1413 (mm-destroy-parts (cdr handle)) | |
1414 (setcdr handle new)))) | |
1415 (mh-mime-display-security handle) | |
1416 (goto-char point)))) | |
1417 | 870 |
1418 ;; Shush compiler. | 871 ;; Shush compiler. |
1419 (eval-when-compile | 872 (eval-when-compile |
1420 (defvar mm-verify-function-alist nil) | 873 (when (< emacs-major-version 22) |
1421 (defvar mm-decrypt-function-alist nil)) | 874 (defvar mm-verify-function-alist) |
1422 | 875 (defvar mm-decrypt-function-alist)) |
1423 (defvar pressed-details) | 876 (mh-do-in-xemacs |
877 (defvar pressed-details))) | |
1424 | 878 |
1425 (defun mh-insert-mime-security-button (handle) | 879 (defun mh-insert-mime-security-button (handle) |
1426 "Display buttons for PGP message, HANDLE." | 880 "Display buttons for PGP message, HANDLE." |
1427 (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) | 881 (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) |
1428 (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist)) | 882 (crypto-type (or (nth 2 (assoc protocol mm-verify-function-alist)) |
1463 "verification" "decryption")) | 917 "verification" "decryption")) |
1464 (warning (if (equal type "decryption") | 918 (warning (if (equal type "decryption") |
1465 "(passphrase may be incorrect)" ""))) | 919 "(passphrase may be incorrect)" ""))) |
1466 (message "%s %s failed %s" crypto-type type warning))))) | 920 (message "%s %s failed %s" crypto-type type warning))))) |
1467 | 921 |
1468 (defun mh-mm-inline-message (handle) | 922 (defun mh-mime-security-button-face (info) |
1469 "Display message, HANDLE. | 923 "Return the button face to use for encrypted/signed mail based on INFO." |
1470 The function decodes the message and displays it. It avoids | 924 (cond ((string-match "OK" info) ;Decrypted mail |
1471 decoding the same message multiple times." | 925 'mh-show-pgg-good) |
1472 (let ((b (point)) | 926 ((string-match "Failed" info) ;Decryption failed or signature invalid |
1473 (clean-message-header mh-clean-message-header-flag) | 927 'mh-show-pgg-bad) |
1474 (invisible-headers mh-invisible-header-fields-compiled) | 928 ((string-match "Undecided" info);Unprocessed mail |
1475 (visible-headers nil)) | 929 'mh-show-pgg-unknown) |
930 ((string-match "Untrusted" info);Key not trusted | |
931 'mh-show-pgg-unknown) | |
932 (t | |
933 'mh-show-pgg-good))) | |
934 | |
935 | |
936 | |
937 ;;; Button Handlers | |
938 | |
939 (defun mh-folder-mime-action (part-index action include-security-flag) | |
940 "Go to PART-INDEX and carry out ACTION. | |
941 | |
942 If PART-INDEX is nil then go to the next part in the buffer. The | |
943 search for the next buffer wraps around if end of buffer is reached. | |
944 If argument INCLUDE-SECURITY-FLAG is non-nil then include security | |
945 info buttons when searching for a suitable parts." | |
946 (unless mh-showing-mode | |
947 (mh-show)) | |
948 (mh-in-show-buffer (mh-show-buffer) | |
949 (let ((criterion | |
950 (cond (part-index | |
951 (lambda (p) | |
952 (let ((part (get-text-property p 'mh-part))) | |
953 (and (integerp part) (= part part-index))))) | |
954 (t (lambda (p) | |
955 (if include-security-flag | |
956 (get-text-property p 'mh-data) | |
957 (integerp (get-text-property p 'mh-part))))))) | |
958 (point (point))) | |
959 (cond ((and (get-text-property point 'mh-part) | |
960 (or (null part-index) | |
961 (= (get-text-property point 'mh-part) part-index))) | |
962 (funcall action)) | |
963 ((and (get-text-property point 'mh-data) | |
964 include-security-flag | |
965 (null part-index)) | |
966 (funcall action)) | |
967 (t | |
968 (mh-goto-next-button nil criterion) | |
969 (if (= (point) point) | |
970 (message "No matching MIME part found") | |
971 (funcall action))))))) | |
972 | |
973 ;;;###mh-autoload | |
974 (defun mh-goto-next-button (backward-flag &optional criterion) | |
975 "Search for next button satisfying criterion. | |
976 | |
977 If BACKWARD-FLAG is non-nil search backward in the buffer for a mime | |
978 button. | |
979 If CRITERION is a function or a symbol which has a function binding | |
980 then that function must return non-nil at the button we stop." | |
981 (unless (or (and (symbolp criterion) (fboundp criterion)) | |
982 (functionp criterion)) | |
983 (setq criterion (lambda (x) t))) | |
984 ;; Move to the next button in the buffer satisfying criterion | |
985 (goto-char (or (save-excursion | |
986 (beginning-of-line) | |
987 ;; Find point before current button | |
988 (let ((point-before-current-button | |
989 (save-excursion | |
990 (while (get-text-property (point) 'mh-data) | |
991 (unless (= (forward-line | |
992 (if backward-flag 1 -1)) | |
993 0) | |
994 (if backward-flag | |
995 (goto-char (point-min)) | |
996 (goto-char (point-max))))) | |
997 (point)))) | |
998 ;; Skip over current button | |
999 (while (and (get-text-property (point) 'mh-data) | |
1000 (not (if backward-flag (bobp) (eobp)))) | |
1001 (forward-line (if backward-flag -1 1))) | |
1002 ;; Stop at next MIME button if any exists. | |
1003 (block loop | |
1004 (while (/= (progn | |
1005 (unless (= (forward-line | |
1006 (if backward-flag -1 1)) | |
1007 0) | |
1008 (if backward-flag | |
1009 (goto-char (point-max)) | |
1010 (goto-char (point-min))) | |
1011 (beginning-of-line)) | |
1012 (point)) | |
1013 point-before-current-button) | |
1014 (when (and (get-text-property (point) 'mh-data) | |
1015 (funcall criterion (point))) | |
1016 (return-from loop (point)))) | |
1017 nil))) | |
1018 (point)))) | |
1019 | |
1020 (defun mh-widget-press-button (widget el) | |
1021 "Callback for widget, WIDGET. | |
1022 Parameter EL is unused." | |
1023 (goto-char (widget-get widget :from)) | |
1024 (mh-press-button)) | |
1025 | |
1026 (defun mh-press-button () | |
1027 "View contents of button. | |
1028 | |
1029 This command is a toggle so if you use it again on the same | |
1030 attachment, the attachment is hidden." | |
1031 (interactive) | |
1032 (let ((mm-inline-media-tests mh-mm-inline-media-tests) | |
1033 (data (get-text-property (point) 'mh-data)) | |
1034 (function (get-text-property (point) 'mh-callback)) | |
1035 (buffer-read-only nil) | |
1036 (folder mh-show-folder-buffer)) | |
1037 (flet ((mm-handle-set-external-undisplayer | |
1038 (handle function) | |
1039 (mh-handle-set-external-undisplayer folder handle function))) | |
1040 (when (and function (eolp)) | |
1041 (backward-char)) | |
1042 (unwind-protect (and function (funcall function data)) | |
1043 (set-buffer-modified-p nil))))) | |
1044 | |
1045 (defun mh-push-button (event) | |
1046 "Click MIME button for EVENT. | |
1047 | |
1048 If the MIME part is visible then it is removed. Otherwise the | |
1049 part is displayed. This function is called when the mouse is used | |
1050 to click the MIME button." | |
1051 (interactive "e") | |
1052 (mh-do-at-event-location event | |
1053 (let ((folder mh-show-folder-buffer) | |
1054 (mm-inline-media-tests mh-mm-inline-media-tests) | |
1055 (data (get-text-property (point) 'mh-data)) | |
1056 (function (get-text-property (point) 'mh-callback))) | |
1057 (flet ((mm-handle-set-external-undisplayer (handle func) | |
1058 (mh-handle-set-external-undisplayer folder handle func))) | |
1059 (and function (funcall function data)))))) | |
1060 | |
1061 (defun mh-handle-set-external-undisplayer (folder handle function) | |
1062 "Replacement for `mm-handle-set-external-undisplayer'. | |
1063 | |
1064 This is only called in recent versions of Gnus. The MIME handles | |
1065 are stored in data structures corresponding to MH-E folder buffer | |
1066 FOLDER instead of in Gnus (as in the original). The MIME part, | |
1067 HANDLE is associated with the undisplayer FUNCTION." | |
1068 (if (mm-keep-viewer-alive-p handle) | |
1069 (let ((new-handle (copy-sequence handle))) | |
1070 (mm-handle-set-undisplayer new-handle function) | |
1071 (mm-handle-set-undisplayer handle nil) | |
1072 (save-excursion | |
1073 (set-buffer folder) | |
1074 (push new-handle (mh-mime-handles (mh-buffer-data))))) | |
1075 (mm-handle-set-undisplayer handle function))) | |
1076 | |
1077 (defun mh-mime-security-press-button (handle) | |
1078 "Callback from security button for part HANDLE." | |
1079 (if (mm-handle-multipart-ctl-parameter handle 'gnus-info) | |
1080 (mh-mime-security-show-details handle) | |
1081 (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region)) | |
1082 point) | |
1083 (setq point (point)) | |
1084 (goto-char (car region)) | |
1085 (delete-region (car region) (cdr region)) | |
1086 (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer) | |
1087 (let* ((mm-verify-option 'known) | |
1088 (mm-decrypt-option 'known) | |
1089 (new (mm-possibly-verify-or-decrypt (cdr handle) handle))) | |
1090 (unless (eq new (cdr handle)) | |
1091 (mm-destroy-parts (cdr handle)) | |
1092 (setcdr handle new)))) | |
1093 (mh-mime-display-security handle) | |
1094 (goto-char point)))) | |
1095 | |
1096 ;; I rewrote the security part because Gnus doesn't seem to ever minimize | |
1097 ;; the button. That is once the mime-security button is pressed there seems | |
1098 ;; to be no way of getting rid of the inserted text. | |
1099 (defun mh-mime-security-show-details (handle) | |
1100 "Toggle display of detailed security info for HANDLE." | |
1101 (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details))) | |
1102 (when details | |
1103 (let ((mh-mime-security-button-pressed | |
1104 (not (get-text-property (point) 'mh-button-pressed))) | |
1105 (mh-mime-security-button-line-format | |
1106 (get-text-property (point) 'mh-line-format))) | |
1107 (forward-char -1) | |
1108 (while (eq (get-text-property (point) 'mh-line-format) | |
1109 mh-mime-security-button-line-format) | |
1110 (forward-char -1)) | |
1111 (forward-char) | |
1112 (save-restriction | |
1113 (narrow-to-region (point) (point)) | |
1114 (mh-insert-mime-security-button handle)) | |
1115 (delete-region | |
1116 (point) | |
1117 (or (text-property-not-all | |
1118 (point) (point-max) | |
1119 'mh-line-format mh-mime-security-button-line-format) | |
1120 (point-max))) | |
1121 (forward-line -1))))) | |
1122 | |
1123 | |
1124 | |
1125 ;;; Miscellaneous Article Washing | |
1126 | |
1127 ;;;###mh-autoload | |
1128 (defun mh-add-missing-mime-version-header () | |
1129 "Some mail programs don't put a MIME-Version header. | |
1130 I have seen this only in spam, so maybe we shouldn't fix | |
1131 this ;-)" | |
1132 (save-excursion | |
1133 (goto-char (point-min)) | |
1134 (re-search-forward "\n\n" nil t) | |
1135 (save-restriction | |
1136 (narrow-to-region (point-min) (point)) | |
1137 (when (and (message-fetch-field "content-type") | |
1138 (not (message-fetch-field "mime-version"))) | |
1139 (goto-char (point-min)) | |
1140 (insert "MIME-Version: 1.0\n"))))) | |
1141 | |
1142 ;;;###mh-autoload | |
1143 (defun mh-display-smileys () | |
1144 "Display smileys." | |
1145 (when (and mh-graphical-smileys-flag (mh-small-show-buffer-p)) | |
1146 (mh-funcall-if-exists smiley-region (point-min) (point-max)))) | |
1147 | |
1148 ;;;###mh-autoload | |
1149 (defun mh-display-emphasis () | |
1150 "Display graphical emphasis." | |
1151 (when (and mh-graphical-emphasis-flag (mh-small-show-buffer-p)) | |
1152 (flet ((article-goto-body ())) ; shadow this function to do nothing | |
1153 (save-excursion | |
1154 (goto-char (point-min)) | |
1155 (article-emphasize))))) | |
1156 | |
1157 (defun mh-small-show-buffer-p () | |
1158 "Check if show buffer is small. | |
1159 This is used to decide if smileys and graphical emphasis should be | |
1160 displayed." | |
1161 (let ((max nil)) | |
1162 (when (and (boundp 'font-lock-maximum-size) font-lock-maximum-size) | |
1163 (cond ((numberp font-lock-maximum-size) | |
1164 (setq max font-lock-maximum-size)) | |
1165 ((listp font-lock-maximum-size) | |
1166 (setq max (cdr (or (assoc 'mh-show-mode font-lock-maximum-size) | |
1167 (assoc t font-lock-maximum-size))))))) | |
1168 (or (not (numberp max)) (>= (/ max 8) (buffer-size))))) | |
1169 | |
1170 | |
1171 | |
1172 ;;; MH-Letter Commands | |
1173 | |
1174 ;; MH-E commands are alphabetical; specific support routines follow command. | |
1175 | |
1176 ;;;###mh-autoload | |
1177 (defun mh-compose-forward (&optional description folder range) | |
1178 "Add tag to forward a message. | |
1179 | |
1180 You are prompted for a content DESCRIPTION, the name of the | |
1181 FOLDER in which the messages to forward are located, and a RANGE | |
1182 of messages, which defaults to the current message in that | |
1183 folder. Check the documentation of `mh-interactive-range' to see | |
1184 how RANGE is read in interactive use. | |
1185 | |
1186 The option `mh-compose-insertion' controls what type of tags are inserted." | |
1187 (interactive | |
1188 (let* ((description | |
1189 (mml-minibuffer-read-description)) | |
1190 (folder | |
1191 (mh-prompt-for-folder "Message from" | |
1192 mh-sent-from-folder nil)) | |
1193 (default | |
1194 (if (and (equal folder mh-sent-from-folder) | |
1195 (numberp mh-sent-from-msg)) | |
1196 mh-sent-from-msg | |
1197 (nth 0 (mh-translate-range folder "cur")))) | |
1198 (range | |
1199 (mh-read-range "Forward" folder | |
1200 (or (and default | |
1201 (number-to-string default)) | |
1202 t) | |
1203 t t))) | |
1204 (list description folder range))) | |
1205 (let ((messages (mapconcat 'identity (mh-list-to-string range) " "))) | |
1206 (dolist (message (mh-translate-range folder messages)) | |
1207 (if (equal mh-compose-insertion 'mml) | |
1208 (mh-mml-forward-message description folder (format "%s" message)) | |
1209 (mh-mh-forward-message description folder (format "%s" message)))))) | |
1210 | |
1211 ;;;###mh-autoload | |
1212 (defun mh-mml-forward-message (description folder message) | |
1213 "Forward a message as attachment. | |
1214 | |
1215 The function will prompt the user for a DESCRIPTION, a FOLDER and | |
1216 MESSAGE number." | |
1217 (let ((msg (if (and (equal message "") (numberp mh-sent-from-msg)) | |
1218 mh-sent-from-msg | |
1219 (string-to-number message)))) | |
1220 (cond ((integerp msg) | |
1221 (if (string= "" description) | |
1222 ;; Rationale: mml-attach-file constructs a malformed composition | |
1223 ;; if the description string is empty. This fixes SF #625168. | |
1224 (mml-attach-file (format "%s%s/%d" | |
1225 mh-user-path (substring folder 1) msg) | |
1226 "message/rfc822") | |
1227 (mml-attach-file (format "%s%s/%d" | |
1228 mh-user-path (substring folder 1) msg) | |
1229 "message/rfc822" | |
1230 description))) | |
1231 (t (error "The message number, %s, is not a integer" msg))))) | |
1232 | |
1233 (defun mh-mh-forward-message (&optional description folder messages) | |
1234 "Add tag to forward a message. | |
1235 You are prompted for a content DESCRIPTION, the name of the | |
1236 FOLDER in which the messages to forward are located, and the | |
1237 MESSAGES' numbers. | |
1238 | |
1239 See also \\[mh-mh-to-mime]." | |
1240 (interactive (list | |
1241 (mml-minibuffer-read-description) | |
1242 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil) | |
1243 (read-string (concat "Messages" | |
1244 (if (numberp mh-sent-from-msg) | |
1245 (format " (default %d): " | |
1246 mh-sent-from-msg) | |
1247 ": "))))) | |
1248 (beginning-of-line) | |
1249 (insert "#forw [") | |
1250 (and description | |
1251 (not (string= description "")) | |
1252 (insert description)) | |
1253 (insert "]") | |
1254 (and folder | |
1255 (not (string= folder "")) | |
1256 (insert " " folder)) | |
1257 (if (and messages | |
1258 (not (string= messages ""))) | |
1259 (let ((start (point))) | |
1260 (insert " " messages) | |
1261 (subst-char-in-region start (point) ?, ? )) | |
1262 (if (numberp mh-sent-from-msg) | |
1263 (insert " " (int-to-string mh-sent-from-msg)))) | |
1264 (insert "\n")) | |
1265 | |
1266 ;;;###mh-autoload | |
1267 (defun mh-compose-insertion (&optional inline) | |
1268 "Add tag to include a file such as an image or sound. | |
1269 | |
1270 You are prompted for the filename containing the object, the | |
1271 media type if it cannot be determined automatically, and a | |
1272 content description. If you're using MH-style directives, you | |
1273 will also be prompted for additional attributes. | |
1274 | |
1275 The option `mh-compose-insertion' controls what type of tags are | |
1276 inserted. Optional argument INLINE means make it an inline | |
1277 attachment." | |
1278 (interactive "P") | |
1279 (if (equal mh-compose-insertion 'mml) | |
1280 (if inline | |
1281 (mh-mml-attach-file "inline") | |
1282 (mh-mml-attach-file)) | |
1283 (call-interactively 'mh-mh-attach-file))) | |
1284 | |
1285 (defun mh-mml-attach-file (&optional disposition) | |
1286 "Add a tag to insert a MIME message part from a file. | |
1287 | |
1288 You are prompted for the filename containing the object, the | |
1289 media type if it cannot be determined automatically, a content | |
1290 description and the DISPOSITION of the attachment. | |
1291 | |
1292 This is basically `mml-attach-file' from Gnus, modified such that a prefix | |
1293 argument yields an \"inline\" disposition and Content-Type is determined | |
1294 automatically." | |
1295 (let* ((file (mml-minibuffer-read-file "Attach file: ")) | |
1296 (type (mh-minibuffer-read-type file)) | |
1297 (description (mml-minibuffer-read-description)) | |
1298 (dispos (or disposition | |
1299 (mml-minibuffer-read-disposition type)))) | |
1300 (mml-insert-empty-tag 'part 'type type 'filename file | |
1301 'disposition dispos 'description description))) | |
1302 | |
1303 (defun mh-mh-attach-file (filename type description attributes) | |
1304 "Add a tag to insert a MIME message part from a file. | |
1305 You are prompted for the FILENAME containing the object, the | |
1306 media TYPE if it cannot be determined automatically, and a | |
1307 content DESCRIPTION. In addition, you are also prompted for | |
1308 additional ATTRIBUTES. | |
1309 | |
1310 See also \\[mh-mh-to-mime]." | |
1311 (interactive (let ((filename (mml-minibuffer-read-file "Attach file: "))) | |
1312 (list | |
1313 filename | |
1314 (mh-minibuffer-read-type filename) | |
1315 (mml-minibuffer-read-description) | |
1316 (read-string "Attributes: " | |
1317 (concat "name=\"" | |
1318 (file-name-nondirectory filename) | |
1319 "\""))))) | |
1320 (mh-mh-compose-type filename type description attributes)) | |
1321 | |
1322 (defun mh-mh-compose-type (filename type | |
1323 &optional description attributes comment) | |
1324 "Insert an MH-style directive to insert a file. | |
1325 The file specified by FILENAME is encoded as TYPE. An optional | |
1326 DESCRIPTION is used as the Content-Description field, optional | |
1327 set of ATTRIBUTES and an optional COMMENT can also be included." | |
1328 (beginning-of-line) | |
1329 (insert "#" type) | |
1330 (and attributes | |
1331 (insert "; " attributes)) | |
1332 (and comment | |
1333 (insert " (" comment ")")) | |
1334 (insert " [") | |
1335 (and description | |
1336 (insert description)) | |
1337 (insert "] " (expand-file-name filename)) | |
1338 (insert "\n")) | |
1339 | |
1340 ;;;###mh-autoload | |
1341 (defun mh-mh-compose-anon-ftp (host filename type description) | |
1342 "Add tag to include anonymous ftp reference to a file. | |
1343 | |
1344 You can have your message initiate an \"ftp\" transfer when the | |
1345 recipient reads the message. You are prompted for the remote HOST | |
1346 and FILENAME, the media TYPE, and the content DESCRIPTION. | |
1347 | |
1348 See also \\[mh-mh-to-mime]." | |
1349 (interactive (list | |
1350 (read-string "Remote host: ") | |
1351 (read-string "Remote filename: ") | |
1352 (mh-minibuffer-read-type "DUMMY-FILENAME") | |
1353 (mml-minibuffer-read-description))) | |
1354 (mh-mh-compose-external-type "anon-ftp" host filename | |
1355 type description)) | |
1356 | |
1357 ;;;###mh-autoload | |
1358 (defun mh-mh-compose-external-compressed-tar (host filename description) | |
1359 "Add tag to include anonymous ftp reference to a compressed tar file. | |
1360 | |
1361 In addition to retrieving the file via anonymous \"ftp\" as per | |
1362 the command \\[mh-mh-compose-anon-ftp], the file will also be | |
1363 uncompressed and untarred. You are prompted for the remote HOST | |
1364 and FILENAME and the content DESCRIPTION. | |
1365 | |
1366 See also \\[mh-mh-to-mime]." | |
1367 (interactive (list | |
1368 (read-string "Remote host: ") | |
1369 (read-string "Remote filename: ") | |
1370 (mml-minibuffer-read-description))) | |
1371 (mh-mh-compose-external-type "anon-ftp" host filename | |
1372 "application/octet-stream" | |
1373 description | |
1374 "type=tar; conversions=x-compress" | |
1375 "mode=image")) | |
1376 | |
1377 ;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One: | |
1378 ;; Format of Internet Message Bodies. | |
1379 ;; RFC 2046 - Multipurpose Internet Mail Extensions (MIME) Part Two: | |
1380 ;; Media Types. | |
1381 ;; RFC 2049 - Multipurpose Internet Mail Extensions (MIME) Part Five: | |
1382 ;; Conformance Criteria and Examples. | |
1383 ;; RFC 2017 - Definition of the URL MIME External-Body Access-Type | |
1384 ;; RFC 1738 - Uniform Resource Locators (URL) | |
1385 (defvar mh-access-types | |
1386 '(("anon-ftp") ; RFC2046 Anonymous File Transfer Protocol | |
1387 ("file") ; RFC1738 Host-specific file names | |
1388 ("ftp") ; RFC2046 File Transfer Protocol | |
1389 ("gopher") ; RFC1738 The Gopher Protocol | |
1390 ("http") ; RFC1738 Hypertext Transfer Protocol | |
1391 ("local-file") ; RFC2046 Local file access | |
1392 ("mail-server") ; RFC2046 mail-server Electronic mail address | |
1393 ("mailto") ; RFC1738 Electronic mail address | |
1394 ("news") ; RFC1738 Usenet news | |
1395 ("nntp") ; RFC1738 Usenet news using NNTP access | |
1396 ("propspero") ; RFC1738 Prospero Directory Service | |
1397 ("telnet") ; RFC1738 Telnet | |
1398 ("tftp") ; RFC2046 Trivial File Transfer Protocol | |
1399 ("url") ; RFC2017 URL scheme MIME access-type Protocol | |
1400 ("wais")) ; RFC1738 Wide Area Information Servers | |
1401 "Valid MIME access-type values.") | |
1402 | |
1403 ;;;###mh-autoload | |
1404 (defun mh-mh-compose-external-type (access-type host filename type | |
1405 &optional description | |
1406 attributes parameters | |
1407 comment) | |
1408 "Add tag to refer to a remote file. | |
1409 | |
1410 This command is a general utility for referencing external files. | |
1411 In fact, all of the other commands that insert directives to | |
1412 access external files call this command. You are prompted for the | |
1413 ACCESS-TYPE, remote HOST and FILENAME, and content TYPE. If you | |
1414 provide a prefix argument, you are also prompted for a content | |
1415 DESCRIPTION, ATTRIBUTES, PARAMETERS, and a COMMENT. | |
1416 | |
1417 See also \\[mh-mh-to-mime]." | |
1418 (interactive (list | |
1419 (completing-read "Access type: " mh-access-types) | |
1420 (read-string "Remote host: ") | |
1421 (read-string "Remote filename: ") | |
1422 (mh-minibuffer-read-type "DUMMY-FILENAME") | |
1423 (if current-prefix-arg (mml-minibuffer-read-description)) | |
1424 (if current-prefix-arg (read-string "Attributes: ")) | |
1425 (if current-prefix-arg (read-string "Parameters: ")) | |
1426 (if current-prefix-arg (read-string "Comment: ")))) | |
1427 (beginning-of-line) | |
1428 (insert "#@" type) | |
1429 (and attributes | |
1430 (insert "; " attributes)) | |
1431 (and comment | |
1432 (insert " (" comment ") ")) | |
1433 (insert " [") | |
1434 (and description | |
1435 (insert description)) | |
1436 (insert "] ") | |
1437 (insert "access-type=" access-type "; ") | |
1438 (insert "site=" host) | |
1439 (insert "; name=" (file-name-nondirectory filename)) | |
1440 (let ((directory (file-name-directory filename))) | |
1441 (and directory | |
1442 (insert "; directory=\"" directory "\""))) | |
1443 (and parameters | |
1444 (insert "; " parameters)) | |
1445 (insert "\n")) | |
1446 | |
1447 (defvar mh-mh-to-mime-args nil | |
1448 "Extra arguments for \\[mh-mh-to-mime] to pass to the \"mhbuild\" command. | |
1449 The arguments are passed to \"mhbuild\" if \\[mh-mh-to-mime] is | |
1450 given a prefix argument. Normally default arguments to | |
1451 \"mhbuild\" are specified in the MH profile.") | |
1452 | |
1453 ;;;###mh-autoload | |
1454 (defun mh-mh-to-mime (&optional extra-args) | |
1455 "Compose MIME message from MH-style directives. | |
1456 | |
1457 Typically, you send a message with attachments just like any other | |
1458 message. However, you may take a sneak preview of the MIME encoding if | |
1459 you wish by running this command. | |
1460 | |
1461 If you wish to pass additional arguments to \"mhbuild\" (\"mhn\") | |
1462 to affect how it builds your message, use the option | |
1463 `mh-mh-to-mime-args'. For example, you can build a consistency | |
1464 check into the message by setting `mh-mh-to-mime-args' to | |
1465 \"-check\". The recipient of your message can then run \"mhbuild | |
1466 -check\" on the message--\"mhbuild\" (\"mhn\") will complain if | |
1467 the message has been corrupted on the way. This command only | |
1468 consults this option when given a prefix argument EXTRA-ARGS. | |
1469 | |
1470 The hook `mh-mh-to-mime-hook' is called after the message has been | |
1471 formatted. | |
1472 | |
1473 The effects of this command can be undone by running | |
1474 \\[mh-mh-to-mime-undo]." | |
1475 (interactive "*P") | |
1476 (mh-mh-quote-unescaped-sharp) | |
1477 (save-buffer) | |
1478 (message "Running %s..." (if (mh-variant-p 'nmh) "mhbuild" "mhn")) | |
1479 (cond | |
1480 ((mh-variant-p 'nmh) | |
1481 (mh-exec-cmd-error nil | |
1482 "mhbuild" | |
1483 (if extra-args mh-mh-to-mime-args) | |
1484 buffer-file-name)) | |
1485 (t | |
1486 (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name) | |
1487 "mhn" | |
1488 (if extra-args mh-mh-to-mime-args) | |
1489 buffer-file-name))) | |
1490 (revert-buffer t t) | |
1491 (message "Running %s...done" (if (mh-variant-p 'nmh) "mhbuild" "mhn")) | |
1492 (run-hooks 'mh-mh-to-mime-hook)) | |
1493 | |
1494 (defun mh-mh-quote-unescaped-sharp () | |
1495 "Quote \"#\" characters that haven't been quoted for \"mhbuild\". | |
1496 If the \"#\" character is present in the first column, but it isn't | |
1497 part of a MH-style directive then \"mhbuild\" gives an error. | |
1498 This function will quote all such characters." | |
1499 (save-excursion | |
1500 (goto-char (point-min)) | |
1501 (while (re-search-forward "^#" nil t) | |
1502 (beginning-of-line) | |
1503 (unless (mh-mh-directive-present-p (point) (line-end-position)) | |
1504 (insert "#")) | |
1505 (goto-char (line-end-position))))) | |
1506 | |
1507 ;;;###mh-autoload | |
1508 (defun mh-mh-to-mime-undo (noconfirm) | |
1509 "Undo effects of \\[mh-mh-to-mime]. | |
1510 | |
1511 It does this by reverting to a backup file. You are prompted to | |
1512 confirm this action, but you can avoid the confirmation by adding | |
1513 a prefix argument NOCONFIRM." | |
1514 (interactive "*P") | |
1515 (if (null buffer-file-name) | |
1516 (error "Buffer does not seem to be associated with any file")) | |
1517 (let ((backup-strings '("," "#")) | |
1518 backup-file) | |
1519 (while (and backup-strings | |
1520 (not (file-exists-p | |
1521 (setq backup-file | |
1522 (concat (file-name-directory buffer-file-name) | |
1523 (car backup-strings) | |
1524 (file-name-nondirectory buffer-file-name) | |
1525 ".orig"))))) | |
1526 (setq backup-strings (cdr backup-strings))) | |
1527 (or backup-strings | |
1528 (error "Backup file for %s no longer exists" buffer-file-name)) | |
1529 (or noconfirm | |
1530 (yes-or-no-p (format "Revert buffer from file %s? " | |
1531 backup-file)) | |
1532 (error "Revert not confirmed")) | |
1533 (let ((buffer-read-only nil)) | |
1534 (erase-buffer) | |
1535 (insert-file-contents backup-file)) | |
1536 (after-find-file nil))) | |
1537 | |
1538 ;; Shush compiler. | |
1539 (eval-when-compile (defvar mh-identity-pgg-default-user-id)) | |
1540 | |
1541 ;;;###mh-autoload | |
1542 (defun mh-mml-secure-message-encrypt (method) | |
1543 "Add tag to encrypt the message. | |
1544 | |
1545 A proper multipart message is created for you when you send the | |
1546 message. Use the command \\[mh-mml-unsecure-message] to remove | |
1547 this tag. Use a prefix argument METHOD to be prompted for one of | |
1548 the possible security methods (see `mh-mml-method-default')." | |
1549 (interactive (list (mh-mml-query-cryptographic-method))) | |
1550 (mh-secure-message method "encrypt" mh-identity-pgg-default-user-id)) | |
1551 | |
1552 ;;;###mh-autoload | |
1553 (defun mh-mml-secure-message-sign (method) | |
1554 "Add tag to sign the message. | |
1555 | |
1556 A proper multipart message is created for you when you send the | |
1557 message. Use the command \\[mh-mml-unsecure-message] to remove | |
1558 this tag. Use a prefix argument METHOD to be prompted for one of | |
1559 the possible security methods (see `mh-mml-method-default')." | |
1560 (interactive (list (mh-mml-query-cryptographic-method))) | |
1561 (mh-secure-message method "sign" mh-identity-pgg-default-user-id)) | |
1562 | |
1563 ;;;###mh-autoload | |
1564 (defun mh-mml-secure-message-signencrypt (method) | |
1565 "Add tag to encrypt and sign the message. | |
1566 | |
1567 A proper multipart message is created for you when you send the | |
1568 message. Use the command \\[mh-mml-unsecure-message] to remove | |
1569 this tag. Use a prefix argument METHOD to be prompted for one of | |
1570 the possible security methods (see `mh-mml-method-default')." | |
1571 (interactive (list (mh-mml-query-cryptographic-method))) | |
1572 (mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id)) | |
1573 | |
1574 (defvar mh-mml-cryptographic-method-history ()) | |
1575 | |
1576 (defun mh-mml-query-cryptographic-method () | |
1577 "Read the cryptographic method to use." | |
1578 (if current-prefix-arg | |
1579 (let ((def (or (car mh-mml-cryptographic-method-history) | |
1580 mh-mml-method-default))) | |
1581 (completing-read (format "Method (default %s): " def) | |
1582 '(("pgp") ("pgpmime") ("smime")) | |
1583 nil t nil 'mh-mml-cryptographic-method-history def)) | |
1584 mh-mml-method-default)) | |
1585 | |
1586 (defun mh-secure-message (method mode &optional identity) | |
1587 "Add tag to encrypt or sign message. | |
1588 | |
1589 METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\". | |
1590 MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\". | |
1591 IDENTITY is optionally the default-user-id to use." | |
1592 (if (not mh-pgp-support-flag) | |
1593 (error "Your version of Gnus does not support PGP/GPG") | |
1594 ;; Check the arguments | |
1595 (let ((valid-methods (list "pgpmime" "pgp" "smime")) | |
1596 (valid-modes (list "sign" "encrypt" "signencrypt" "none"))) | |
1597 (if (not (member method valid-methods)) | |
1598 (error "Method %s is invalid" method)) | |
1599 (if (not (member mode valid-modes)) | |
1600 (error "Mode %s is invalid" mode)) | |
1601 (mml-unsecure-message) | |
1602 (if (not (string= mode "none")) | |
1603 (save-excursion | |
1604 (goto-char (point-min)) | |
1605 (mh-goto-header-end 1) | |
1606 (if mh-identity-pgg-default-user-id | |
1607 (mml-insert-tag 'secure 'method method 'mode mode | |
1608 'sender mh-identity-pgg-default-user-id) | |
1609 (mml-insert-tag 'secure 'method method 'mode mode))))))) | |
1610 | |
1611 ;;;###mh-autoload | |
1612 (defun mh-mml-to-mime () | |
1613 "Compose MIME message from MML tags. | |
1614 | |
1615 Typically, you send a message with attachments just like any | |
1616 other message. However, you may take a sneak preview of the MIME | |
1617 encoding if you wish by running this command. | |
1618 | |
1619 This action can be undone by running \\[undo]." | |
1620 (interactive) | |
1621 (require 'message) | |
1622 (when mh-pgp-support-flag ;; This is only needed for PGP | |
1623 (message-options-set-recipient)) | |
1624 (let ((saved-text (buffer-string)) | |
1625 (buffer (current-buffer)) | |
1626 (modified-flag (buffer-modified-p))) | |
1627 (condition-case err (mml-to-mime) | |
1628 (error | |
1629 (with-current-buffer buffer | |
1630 (delete-region (point-min) (point-max)) | |
1631 (insert saved-text) | |
1632 (set-buffer-modified-p modified-flag)) | |
1633 (error (error-message-string err)))))) | |
1634 | |
1635 ;;;###mh-autoload | |
1636 (defun mh-mml-unsecure-message () | |
1637 "Remove any secure message tags." | |
1638 (interactive) | |
1639 (if (not mh-pgp-support-flag) | |
1640 (error "Your version of Gnus does not support PGP/GPG") | |
1641 (mml-unsecure-message))) | |
1642 | |
1643 | |
1644 | |
1645 ;;; Support Routines for MH-Letter Commands | |
1646 | |
1647 ;;;###mh-autoload | |
1648 (defun mh-mml-tag-present-p () | |
1649 "Check if the current buffer has text which may be a MML tag." | |
1650 (save-excursion | |
1651 (goto-char (point-min)) | |
1652 (re-search-forward | |
1653 (concat | |
1654 "\\(<#\\(mml\\|part\\)\\(.\\|\n\\)*>[ \n\t]*<#/\\(mml\\|part\\)>\\|" | |
1655 "^<#secure.+>$\\)") | |
1656 nil t))) | |
1657 | |
1658 (defvar mh-media-type-regexp | |
1659 (concat (regexp-opt '("text" "image" "audio" "video" "application" | |
1660 "multipart" "message") t) | |
1661 "/[-.+a-zA-Z0-9]+") | |
1662 "Regexp matching valid media types used in MIME attachment compositions.") | |
1663 | |
1664 ;;;###mh-autoload | |
1665 (defun mh-mh-directive-present-p (&optional begin end) | |
1666 "Check if the text between BEGIN and END might be a MH-style directive. | |
1667 The optional argument BEGIN defaults to the beginning of the | |
1668 buffer, while END defaults to the the end of the buffer." | |
1669 (unless begin (setq begin (point-min))) | |
1670 (unless end (setq end (point-max))) | |
1671 (save-excursion | |
1672 (block 'search-for-mh-directive | |
1673 (goto-char begin) | |
1674 (while (re-search-forward "^#" end t) | |
1675 (let ((s (buffer-substring-no-properties (point) (line-end-position)))) | |
1676 (cond ((equal s "")) | |
1677 ((string-match "^forw[ \t\n]+" s) | |
1678 (return-from 'search-for-mh-directive t)) | |
1679 (t (let ((first-token (car (split-string s "[ \t;@]")))) | |
1680 (when (and first-token | |
1681 (string-match mh-media-type-regexp | |
1682 first-token)) | |
1683 (return-from 'search-for-mh-directive t))))))) | |
1684 nil))) | |
1685 | |
1686 (defun mh-minibuffer-read-type (filename &optional default) | |
1687 "Return the content type associated with the given FILENAME. | |
1688 If the \"file\" command exists and recognizes the given file, | |
1689 then its value is returned\; otherwise, the user is prompted for | |
1690 a type (see `mailcap-mime-types' and for Emacs 20, | |
1691 `mh-mime-content-types'). | |
1692 Optional argument DEFAULT is returned if a type isn't entered." | |
1693 (mailcap-parse-mimetypes) | |
1694 (let* ((default (or default | |
1695 (mm-default-file-encoding filename) | |
1696 "application/octet-stream")) | |
1697 (probed-type (mh-file-mime-type filename)) | |
1698 (type (or (and (not (equal probed-type "application/octet-stream")) | |
1699 probed-type) | |
1700 (completing-read | |
1701 (format "Content type (default %s): " default) | |
1702 (mapcar 'list (mailcap-mime-types)))))) | |
1703 (if (not (equal type "")) | |
1704 type | |
1705 default))) | |
1706 | |
1707 ;;;###mh-autoload | |
1708 (defun mh-file-mime-type (filename) | |
1709 "Return MIME type of FILENAME from file command. | |
1710 Returns nil if file command not on system." | |
1711 (cond | |
1712 ((not (mh-have-file-command)) | |
1713 nil) ;no file command, exit now | |
1714 ((not (and (file-exists-p filename) | |
1715 (file-readable-p filename))) | |
1716 nil) ;no file or not readable, ditto | |
1717 (t | |
1476 (save-excursion | 1718 (save-excursion |
1477 (save-restriction | 1719 (let ((tmp-buffer (get-buffer-create mh-temp-buffer))) |
1478 (narrow-to-region b b) | 1720 (set-buffer tmp-buffer) |
1479 (mm-insert-part handle) | 1721 (unwind-protect |
1480 (mh-mime-display | 1722 (progn |
1481 (or (gethash handle (mh-mime-handles-cache (mh-buffer-data))) | 1723 (call-process "file" nil '(t nil) nil "-b" "-i" |
1482 (setf (gethash handle (mh-mime-handles-cache (mh-buffer-data))) | 1724 (expand-file-name filename)) |
1483 (let ((handles (mm-dissect-buffer nil))) | 1725 (goto-char (point-min)) |
1484 (if handles | 1726 (if (not (re-search-forward mh-media-type-regexp nil t)) |
1485 (when (fboundp 'mm-uu-dissect-text-parts) | 1727 nil |
1486 (mm-uu-dissect-text-parts handles)) | 1728 (mh-file-mime-type-substitute (match-string 0) filename))) |
1487 (setq handles (mm-uu-dissect))) | 1729 (kill-buffer tmp-buffer))))))) |
1488 (setf (mh-mime-handles (mh-buffer-data)) | 1730 |
1489 (mm-merge-handles | 1731 (defvar mh-file-mime-type-substitutions |
1490 handles (mh-mime-handles (mh-buffer-data)))) | 1732 '(("application/msword" "\.xls" "application/ms-excel") |
1491 handles)))) | 1733 ("application/msword" "\.ppt" "application/ms-powerpoint") |
1492 | 1734 ("text/plain" "\.vcf" "text/x-vcard")) |
1493 (goto-char (point-min)) | 1735 "Substitutions to make for Content-Type returned from file command. |
1494 (mh-show-xface) | 1736 The first element is the Content-Type returned by the file command. |
1495 (cond (clean-message-header | 1737 The second element is a regexp matching the file name, usually the |
1496 (mh-clean-msg-header (point-min) | 1738 extension. |
1497 invisible-headers | 1739 The third element is the Content-Type to replace with.") |
1498 visible-headers) | 1740 |
1499 (goto-char (point-min))) | 1741 (defun mh-file-mime-type-substitute (content-type filename) |
1500 (t | 1742 "Return possibly changed CONTENT-TYPE on the FILENAME. |
1501 (mh-start-of-uncleaned-message))) | 1743 Substitutions are made from the `mh-file-mime-type-substitutions' |
1502 (mh-decode-message-header) | 1744 variable." |
1503 (mh-show-addr) | 1745 (let ((subst mh-file-mime-type-substitutions) |
1504 ;; The other highlighting types don't need anything special | 1746 (type) (match) (answer content-type) |
1505 (when (eq mh-highlight-citation-style 'gnus) | 1747 (case-fold-search t)) |
1506 (mh-gnus-article-highlight-citation)) | 1748 (while subst |
1507 (goto-char (point-min)) | 1749 (setq type (car (car subst)) |
1508 (insert "\n------- Forwarded Message\n\n") | 1750 match (elt (car subst) 1)) |
1509 (mh-display-smileys) | 1751 (if (and (string-equal content-type type) |
1510 (mh-display-emphasis) | 1752 (string-match match filename)) |
1511 (mm-handle-set-undisplayer | 1753 (setq answer (elt (car subst) 2) |
1512 handle | 1754 subst nil) |
1513 `(lambda () | 1755 (setq subst (cdr subst)))) |
1514 (let (buffer-read-only) | 1756 answer)) |
1515 (if (fboundp 'remove-specifier) | 1757 |
1516 ;; This is only valid on XEmacs. | 1758 (defvar mh-have-file-command 'undefined |
1517 (mapcar (lambda (prop) | 1759 "Cached value of function `mh-have-file-command'. |
1518 (remove-specifier | 1760 Do not reference this variable directly as it might not have been |
1519 (face-property 'default prop) (current-buffer))) | 1761 initialized. Always use the command `mh-have-file-command'.") |
1520 '(background background-pixmap foreground))) | 1762 |
1521 (delete-region ,(point-min-marker) ,(point-max-marker))))))))) | 1763 ;;;###mh-autoload |
1764 (defun mh-have-file-command () | |
1765 "Return t if 'file' command is on the system. | |
1766 'file -i' is used to get MIME type of composition insertion." | |
1767 (when (eq mh-have-file-command 'undefined) | |
1768 (setq mh-have-file-command | |
1769 (and (fboundp 'executable-find) | |
1770 (executable-find "file") ; file command exists | |
1771 ; and accepts -i and -b args. | |
1772 (zerop (call-process "file" nil nil nil "-i" "-b" | |
1773 (expand-file-name "inc" mh-progs)))))) | |
1774 mh-have-file-command) | |
1775 | |
1776 | |
1777 | |
1778 ;;; MIME Cleanup | |
1779 | |
1780 ;;;###mh-autoload | |
1781 (defun mh-mime-cleanup () | |
1782 "Free the decoded MIME parts." | |
1783 (let ((mime-data (gethash (current-buffer) mh-globals-hash))) | |
1784 ;; This is for Emacs, what about XEmacs? | |
1785 (mh-funcall-if-exists remove-images (point-min) (point-max)) | |
1786 (when mime-data | |
1787 (mm-destroy-parts (mh-mime-handles mime-data)) | |
1788 (remhash (current-buffer) mh-globals-hash)))) | |
1789 | |
1790 ;;;###mh-autoload | |
1791 (defun mh-destroy-postponed-handles () | |
1792 "Free MIME data for externally displayed MIME parts." | |
1793 (let ((mime-data (mh-buffer-data))) | |
1794 (when mime-data | |
1795 (mm-destroy-parts (mh-mime-handles mime-data))) | |
1796 (remhash (current-buffer) mh-globals-hash))) | |
1522 | 1797 |
1523 (provide 'mh-mime) | 1798 (provide 'mh-mime) |
1524 | 1799 |
1525 ;; Local Variables: | 1800 ;; Local Variables: |
1526 ;; indent-tabs-mode: nil | 1801 ;; indent-tabs-mode: nil |